#!/bin/sh # (C) 2010 by Eugeniy Mikhailov, # vim:set ft=tcl: \ exec tclsh "$0" "$@" # internal version of this code set VERSION 1.0 package require sqlite3 package require ncgi package require md5 ::ncgi::parse # defaults set sortCol LastName set user guest set password guest set action defaultview # defaults end # read cookies set user [::ncgi::cookie user] set sortCol [::ncgi::cookie sortCol] set password [::ncgi::cookie password] set action [::ncgi::value action defaultview] # end of read cookies # script uri if { [catch {set script_name $env(SCRIPT_NAME)} errStat] } { set script_name unknown} # figure out course db filename if { [catch {set request_uri $env(REQUEST_URI)} errStat] } { set request_uri unknown} regsub -all $script_name $request_uri "" coursedbfname regsub -all {\?.*$} $coursedbfname "" coursedbfname regsub -all {^/} $coursedbfname "" coursedbfname set script_name "$script_name/$coursedbfname" # ########################## procs begin ################################# proc dbg {msg {level 1}} { if { $level <=2 } { set fid [open log a+] puts $fid $msg close $fid } } proc ColName2SqlSafeForm {colname} { set bad_symbols [list {\}} {\{} {\\} {\'} {\"} {\]} {\[} ] foreach bs $bad_symbols { regsub -all $bs $colname "" colname } return $colname } proc AddUserNonWeb { first_name last_name user_name password_hash {group_name {guest}} {id_number {}} {section_num {} } } { set eval_str [concat INSERT INTO GradesTable (FirstName, LastName, UserName, PasswordHash, GroupName, IdNum, SectionNum) VALUES('$first_name', '$last_name', '$user_name', '$password_hash', '$group_name', '$id_number', '$section_num')] set err [catch {db eval $eval_str } errStat] if { $err } { htmlErrorMsg $errStat dbg "the following error happen: $errStat" 3 } } proc CreateGradesTable {db} { set err [catch {db eval {CREATE TABLE GradesTable(FirstName text, LastName text, UserName text, PasswordHash text, GroupName text, UserHiddenColums text, UserHiddenGroups text, IdNum text, SectionNum text)} } errStat] if { $err } { htmlErrorMsg $errStat dbg "the following error happen: $errStat" 1 } # add special users aka special info rows AddUserNonWeb {} {} _Col_Category_ {} inforow AddUserNonWeb {} {} _Max_Points_ {} inforow # dummy users AddUserNonWeb Ta "Taevich, I" ta [::md5::md5 -hex qwerty] ta AddUserNonWeb Dan "Dandanovich" dan [::md5::md5 -hex qwerty] student AddUserNonWeb Ale "Alevna" ale [::md5::md5 -hex qwerty] student AddUserNonWeb Jon "Jonovich" jon [::md5::md5 -hex qwerty] student AddUserNonWeb Ins "Instruch I" instructor [::md5::md5 -hex qwerty] instructor # reasonable defaults for hidden columns set instructor_hidden_columns [list UserHiddenColums PasswordHash UserHiddenGroups IdNum] UpdateColValue4GroupNameNonWeb UserHiddenColums instructor $instructor_hidden_columns } proc AddAccessRightNonWeb { action instructor_right ta_right student_right guest_right } { set eval_str [concat INSERT INTO AccessRightsTable (actionname, instructor, ta, student, guest) VALUES('$action', '$instructor_right', '$ta_right', '$student_right', '$guest_right')] set err [catch {db eval $eval_str } errStat] if { $err } { htmlErrorMsg $errStat dbg "the following error happen: $errStat" 3 } } proc CreateAccessRightsTable {db} { set err [catch {db eval {CREATE TABLE AccessRightsTable(actionname text, instructor integer, ta integer, student integer, guest integer)} } errStat] if { $err } { htmlErrorMsg $errStat dbg "the following error happen: $errStat" 1 } # guest should have no rights make sure that 0 is evereywhere except logon # actionname instructor ta student guest AddAccessRightNonWeb logon 1 1 1 1 AddAccessRightNonWeb showgrades 1 1 1 0 AddAccessRightNonWeb sort 1 1 0 0 AddAccessRightNonWeb addcolumnrequest 1 1 0 0 AddAccessRightNonWeb addcolumn 1 1 0 0 AddAccessRightNonWeb deletecolumn 1 1 0 0 AddAccessRightNonWeb showcontrols 1 1 1 0 AddAccessRightNonWeb changegrades 1 1 0 0 AddAccessRightNonWeb updategrades 1 1 0 0 AddAccessRightNonWeb changecolumn 1 1 0 0 AddAccessRightNonWeb updatecolumn 1 1 0 0 AddAccessRightNonWeb logoff 1 1 1 0 AddAccessRightNonWeb changefirstname 1 0 0 0 AddAccessRightNonWeb changelastname 1 0 0 0 AddAccessRightNonWeb changeusername 1 0 0 0 AddAccessRightNonWeb userhidecolumn 1 1 1 0 AddAccessRightNonWeb userunhidecolumn 1 1 1 0 AddAccessRightNonWeb userhidegroup 1 0 0 0 AddAccessRightNonWeb userunhidegroup 1 0 0 0 } proc htmlErrorMsg { msg } { puts "
error: $msg
" } proc htmlReplaceEmptyString { string } { # empty string replaced with "---" regsub {^$} $string "---" string # white spaces only string replaced with "---" regsub {^\s+$} $string "---" string set string } proc htmlDBout {db permission_list user {sort_col {}}} { array set permission $permission_list global script_name set defSortCol LastName if { $sort_col == {} } { set sort_col $defSortCol dbg "empty sort col changed to $sort_col" 4 } # testing for the existense of the sorting column set eval_str [list SELECT * FROM GradesTable ORDER BY $sort_col] set err [catch {db eval $eval_str } errStat] if { $err } { dbg $errStat 3 dbg "changing to default sorting column $defSortCol" 3 set sort_col $defSortCol } puts {
} set show_header 1 # get names of all columns set column_list [getColListFromTable GradesTable] # set hidden column list switch $permission(GroupName) { instructor { set hidden_columns {} } ta { set hidden_columns [list UserName PasswordHash GroupName UserHiddenColums UserHiddenGroups IdNum] } student { set hidden_columns [list FirstName LastName UserName PasswordHash GroupName UserHiddenColums UserHiddenGroups IdNum SectionNum] } guest { set hidden_columns $column_list } default { set hidden_columns $column_list } } # add user hidden columns set hidden_columns [concat $hidden_columns [SelectColValue4User UserHiddenColums $user]] # remove hidden columns from sql request foreach col $hidden_columns { set column_list [removeElementFromList $col $column_list] } set sql_column_str [colList2sqlColStr $column_list] # set users of what group user can see, i.e. set WHERE statement set where_statement {} switch $permission(GroupName) { instructor { # hide unwanted user groups set user_groups_for_hide [SelectColValue4User UserHiddenGroups $user] if {$user_groups_for_hide != {} } { foreach grp $user_groups_for_hide { if { $where_statement == {} } { set where_statement "WHERE GroupName<>\"$grp\"" } else { set where_statement [concat $where_statement "AND GroupName<>\"$grp\""] } } } } ta { set where_statement "WHERE GroupName=\"student\"" } student { set where_statement "WHERE UserName=\"$user\"" } guest { dbg "Guest must not be allowed to set table view port. Aborting. This line is never executed" 0; exit } default { dbg "Default must not be allowed to set table view port. Aborting. This line is never executed." 0; exit } } # get all allowed columns and rows set eval_str [concat SELECT $sql_column_str FROM GradesTable $where_statement ORDER BY $sort_col] set err [catch { db eval $eval_str v { if { $show_header } { set show_header 0 puts {} puts "" foreach col $v(*) { # detect what column category it is set category [SelectColValue4User $col _Col_Category_] puts -nonewline "" puts "" } puts "" puts "" } else { puts "" } foreach index $v(*) { if { $index != "*" } { # detect what column category it is set category [SelectColValue4User $index _Col_Category_] set col_value [htmlReplaceEmptyString $v($index)] puts -nonewline "" } } puts "" } } errStat ] if { $err } { dbg "we should never be here if $sortCol exist in the table" 1 dbg $errStat 1 htmlErrorMsg $errStat } puts "
$col" # below list has action and action_label pairs set action_list {userhidecolumn hide} switch $col { FirstName { lappend action_list changefirstname "change first name" } LastName { lappend action_list changelastname "change last name" } UserName { lappend action_list changeusername "change user name" } PasswordHash { } UserHiddenColums { } UserHiddenGroups { } IdNum { } GroupName { } SectionNum { } default { lappend action_list changegrades "change grades" deletecolumn delete changecolumn "change column" } } set separator {
} foreach {act act_label} $action_list { if { [isActionGranted $act $permission_list $user] } { puts -nonewline "$separator$act_label" } } puts -nonewline "
$col_value
" puts {
} } proc htmlTop {permission_list} { array set permission $permission_list if { $permission(GroupName) == "guest" } { askToLogin } else { Greetings } } proc htmlFooter {permission_list} { array set permission $permission_list global VERSION puts "
" puts "GradeBook $VERSION code is written by Eugeniy Mikhailov" puts "
" } proc SelectColValue4User { colname user } { set value {} set eval_str "SELECT \"$colname\" FROM GradesTable where UserName=\"$user\"" set err [catch { db eval $eval_str v { set value $v($colname) } } errStat ] if { $err } { htmlErrorMsg $errStat dbg "the following error happen: $errStat" 3 } return $value } proc Greetings {} { global user password script_name set FirstName UnknownFirstName set LastName UnknownLastName # get First and Last name info set FirstName [SelectColValue4User FirstName $user] set LastName [SelectColValue4User LastName $user] puts "
" puts ", you are logged in as ." #puts "logoff" puts "
" } proc askToLogin {} { global script_name puts "
" puts "Either you are here first time or you password and user name does not match.
" puts "Please login
" puts "
" puts {Login:
} puts {Password:
} puts {} puts {} puts {
} puts "
" } proc LogMeOn {} { global user password set user [::ncgi::value user guest] set password [::ncgi::value password guest] dbg "Logging in and setting cookies" 4 ::ncgi::setCookie -name user -value $user ::ncgi::setCookie -name password -value $password } proc LogMeOff {} { dbg "Logging off" 4 global user password set user guest set password guest ::ncgi::setCookie -name user -value $user ::ncgi::setCookie -name password -value $password } proc SetSortColumn {} { global sortCol set sortCol [::ncgi::value sortCol LastName] ::ncgi::setCookie -name sortCol -value $sortCol } proc isActionGranted { action permission_list user } { array set permission $permission_list if { $action == "defaultview" } { # this one permitted to everyone dbg "requested action $action for user $user is granted" 4 return 1; } if { ![info exist permission($action) ] } { dbg "requested UNKNOWN action $action for user $user is not granted" 0 htmlErrorMsg "requested UNKNOWN action $action" return 0; } if {$permission($action) } { dbg "requested action $action for user $user is granted" 4 return 1; } else { dbg "requested action $action for user $user is not granted" 1 return 0; } } proc ChoseAction {action permission_list user} { array set permission $permission_list dbg "requested action: $action" 1 if { [isActionGranted $action $permission_list $user] } { switch $action { sort { SetSortColumn; ChoseAction defaultview $permission_list $user } addcolumn { AddColumn $permission_list $user; htmlDefaultView $permission_list $user } addcolumnrequest { AddColumnRequest $permission_list $user } deletecolumn { DeleteColumn $permission_list $user; htmlDefaultView $permission_list $user } changegrades { ChangeGrades $permission_list $user } updategrades { UpdateGrades $permission_list $user htmlDefaultView $permission_list $user } changecolumn { ChangeColumn $permission_list $user } updatecolumn { UpdateColumn $permission_list $user htmlDefaultView $permission_list $user } showcontrols { ShowControls $permission_list $user } userhidecolumn { UserHideColumn $permission_list $user htmlDefaultView $permission_list $user } userunhidecolumn { UserUnHideColumn $permission_list $user htmlDefaultView $permission_list $user } userhidegroup { UserHideGroup $permission_list $user htmlDefaultView $permission_list $user } userunhidegroup { UserUnHideGroup $permission_list $user htmlDefaultView $permission_list $user } showgrades { htmlGradesTable db $permission_list $user } defaultview { htmlDefaultView $permission_list $user } default { htmlErrorMsg "requested action $action is granted but not implemented yet" } } } else { # this action is permitted to everyone by default ChoseAction defaultview $permission_list $user } } proc UserUnHideGroup { permission_list user } { set groupname [::ncgi::value groupname {}] set currently_hidden_groups [SelectColValue4User UserHiddenGroups $user] set currently_hidden_groups [removeElementFromList $groupname $currently_hidden_groups] UpdateColValue4UserNameNonWeb UserHiddenGroups $user $currently_hidden_groups } proc UserHideGroup { permission_list user } { set groupname [::ncgi::value groupname {}] set currently_hidden_groups [SelectColValue4User UserHiddenGroups $user] lappend currently_hidden_groups $groupname UpdateColValue4UserNameNonWeb UserHiddenGroups $user $currently_hidden_groups } proc UserHideColumn { permission_list user } { set columnname [::ncgi::value columnname {}] set currently_hidden_columns [SelectColValue4User UserHiddenColums $user] lappend currently_hidden_columns $columnname UpdateColValue4UserNameNonWeb UserHiddenColums $user $currently_hidden_columns } proc UserUnHideColumn { permission_list user } { set columnname [::ncgi::value columnname {}] set currently_hidden_columns [SelectColValue4User UserHiddenColums $user] set currently_hidden_columns [removeElementFromList $columnname $currently_hidden_columns] UpdateColValue4UserNameNonWeb UserHiddenColums $user $currently_hidden_columns } proc ChangeColumn { permission_list user } { set columnname [::ncgi::value columnname {}] set category "unset" set category [SelectColValue4User $columnname _Col_Category_] set maxpoints [SelectColValue4User $columnname _Max_Points_] puts {
} puts "
" set out_str {} append out_str {Column Name:
} puts $out_str set out_str {} append out_str {Category:
} set out_str {} append out_str {Max Point Possible:
} puts $out_str puts {} set out_str {} append out_str {} puts $out_str puts {} puts {
} puts {
} } proc UpdateColumn { permission_list user } { set oldcolumnname [::ncgi::value oldcolumnname {}] set newcolumnname [::ncgi::value newcolumnname {}] set column_category [::ncgi::value category {}] set maxpointpossible [::ncgi::value maxpointpossible {}] # transform colnames to sql safe form set oldcolumnname [ColName2SqlSafeForm $oldcolumnname] set newcolumnname [ColName2SqlSafeForm $newcolumnname] # first we update category and maxpointpossible values of the old columnname UpdateColValue4UserNameNonWeb $oldcolumnname _Col_Category_ $column_category UpdateColValue4UserNameNonWeb $oldcolumnname _Max_Points_ $maxpointpossible if { $newcolumnname eq $oldcolumnname } { # no need to mess with renaming return } if { $newcolumnname == "" } { htmlErrorMsg "empty column names are not permitted" return } set eval_str [concat SELECT * FROM GradesTable ] set err [catch {db eval $eval_str v {} } errStat] set old_column_list $v(*) # check if column with the suggested new name is already exist foreach cname $old_column_list { if { $cname eq $newcolumnname } { htmlErrorMsg "The column name $newcolumnname is already exist" return } } # sqlite does not allow rename columns # I will first create new column identical to the old one AddColumnNonWeb $newcolumnname $column_category $maxpointpossible set sql_str [concat UPDATE GradesTable SET \"$newcolumnname\"=\"$oldcolumnname\"] set err [catch {db eval $sql_str } errStat] # then delete the old one DeleteColumnNonWeb $oldcolumnname } proc UpdateColValue4UserNameNonWeb { columnname username val } { set sql_str [concat UPDATE GradesTable SET \"$columnname\"=\'$val\' where UserName=\"$username\"] set err2 [catch { db eval $sql_str } errStat2 ] if { $err2 } { htmlErrorMsg $errStat2 dbg "the following error happen: $errStat2" 3 } } proc UpdateColValue4GroupNameNonWeb { columnname groupname val } { set sql_str [concat UPDATE GradesTable SET \"$columnname\"=\'$val\' where GroupName=\"$groupname\"] set err2 [catch { db eval $sql_str } errStat2 ] if { $err2 } { htmlErrorMsg $errStat2 dbg "the following error happen: $errStat2" 3 } } proc UpdateGrades { permission_list user } { global script_name set subaction [::ncgi::value subaction {}] set columnname [::ncgi::value columnname {}] set nv [::ncgi::nvlist] array set colval $nv if { $subaction eq "Submit" } { set eval_str "SELECT UserName FROM GradesTable" set err [catch { db eval $eval_str v { if { [info exist colval($v(UserName))] } { UpdateColValue4UserNameNonWeb $columnname $v(UserName) $colval($v(UserName)) } } } errStat ] if { $err } { htmlErrorMsg $errStat dbg "the following error happen: $errStat" 3 } } } proc ChangeGrades { permission_list user } { global script_name set columnname [::ncgi::value columnname {}] if { $columnname != "" } { # output only selected columns set column_list {} lappend column_list FirstName LastName UserName lappend column_list \"$columnname\" set sql_column_list [join $column_list ","] puts {
} puts {
} puts "
" # output only selected columns set eval_str "SELECT $sql_column_list FROM GradesTable WHERE UserName<>'_Col_Category_' AND UserName<>'_Max_Points_' AND GroupName='student' ORDER BY LastName" set show_header 1 set err [catch { db eval $eval_str v { if { $show_header } { set show_header 0 puts {} puts "" foreach col $v(*) { puts -nonewline "" } puts "" } else { puts "" } foreach index $v(*) { if { $index != "*" } { if { $index eq $columnname } { #column with grade puts "" } else { puts -nonewline "" } } } puts "" } } errStat ] puts "
$col
$v($index)
" if { $err } { htmlErrorMsg $errStat dbg "the following error happen: $errStat" 3 } puts {} puts [concat ] puts {} puts {} puts {
} puts {
} puts {
} #puts "Cancel changes" } else { htmlErrorMsg "empty column names are not permitted" } } proc getColListFromTable { table } { set eval_str [concat SELECT * FROM \'$table\' ] set err [catch {db eval $eval_str v {} } errStat] set old_column_list $v(*) return $old_column_list } proc removeElementFromList { element2remove old_list } { set new_list {} foreach element $old_list { if { $element2remove ne $element } { lappend new_list $element } } return $new_list } proc colList2sqlColStr { col_list } { set sqlStr {} foreach col $col_list { if {$sqlStr ne ""} { set sqlStr $sqlStr,\"$col\" } else { set sqlStr \"$col\" } } return $sqlStr } proc DeleteColumnNonWeb { columnname } { if { $columnname != "" } { # removing the column name to be deleted from total list set old_column_list [getColListFromTable GradesTable] set new_column_list [removeElementFromList $columnname $old_column_list] set sql_new_column_str [colList2sqlColStr $new_column_list] set eval_str "BEGIN TRANSACTION; CREATE TEMPORARY TABLE GradesTable_backup($sql_new_column_str); INSERT INTO GradesTable_backup SELECT $sql_new_column_str FROM GradesTable; DROP TABLE GradesTable; CREATE TABLE GradesTable($sql_new_column_str); INSERT INTO GradesTable SELECT $sql_new_column_str FROM GradesTable_backup; DROP TABLE GradesTable_backup; COMMIT;" set err [catch {db eval $eval_str } errStat] if { $err } { htmlErrorMsg $errStat dbg "the following error happen: $errStat" 3 } } else { htmlErrorMsg "empty column names are not permitted" } } proc DeleteColumn { permission_list user } { global script_name set columnname [::ncgi::value columnname {}] DeleteColumnNonWeb $columnname } proc AddColumnNonWeb { columnname2add column_category maxpointpossible } { if { $columnname2add != "" } { set eval_str [concat ALTER TABLE GradesTable ADD \"$columnname2add\" text] set err [catch {db eval $eval_str } errStat] if { $err } { htmlErrorMsg $errStat dbg "the following error happen: $errStat" 3 } UpdateColValue4UserNameNonWeb $columnname2add _Col_Category_ $column_category UpdateColValue4UserNameNonWeb $columnname2add _Max_Points_ $maxpointpossible } else { htmlErrorMsg "empty column names are not permitted" } } proc AddColumn { permission_list user } { global script_name set columnname2add [::ncgi::value columnname2add {}] set column_category [::ncgi::value column_category {}] set maxpointpossible [::ncgi::value maxpointpossible {}] set columnname2add [ColName2SqlSafeForm $columnname2add] AddColumnNonWeb $columnname2add $column_category $maxpointpossible } proc AddColumnRequest { permission_list user } { global script_name puts {
} puts "
" puts {Column Name:
} puts {Category:
} puts {Max Point Possible:
} puts {} puts {} puts {
} puts {
} } proc ShowControls { permission_list user } { array set permission $permission_list global script_name dbg "outputing contol list" puts "
" set action_list [ list defaultview "Refresh" addcolumnrequest "Add Column" logoff "Logoff" ] set separator { } foreach {act act_label} $action_list { if { [isActionGranted $act $permission_list $user] } { puts -nonewline "$separator$act_label" } } puts "
" # unhide user hidden columns actions set currently_hidden_columns [SelectColValue4User UserHiddenColums $user] if { $currently_hidden_columns ne "" } { puts {Unhide columns: } foreach col $currently_hidden_columns { puts "$col" } } # hide user groups set user_groups_for_hide [list inforow student ta instructor] set currently_hidden_groups [SelectColValue4User UserHiddenGroups $user] # remove already hidden group from offering foreach grp $currently_hidden_groups { set user_groups_for_hide [removeElementFromList $grp $user_groups_for_hide] } # output group to hide offering if { [isActionGranted userhidegroup $permission_list $user] } { if { $user_groups_for_hide ne "" } { puts "
" puts "HideGroup: " foreach grp $user_groups_for_hide { puts "$grp" } } } if { [isActionGranted userunhidegroup $permission_list $user] } { if { $currently_hidden_groups ne "" } { puts "
" puts {Unhide groups: } foreach grp $currently_hidden_groups { puts "$grp" } } } puts "
" } proc AccessGroupRights {db user password } { dbg "access rights check for user: $user" set PasswordHash [::md5::md5 -hex $password] set eval_str [list SELECT GroupName FROM GradesTable WHERE UserName='$user' AND PasswordHash='$PasswordHash'] db eval $eval_str group_name_array {} if { [ info exist group_name_array(GroupName) ] } { set group $group_name_array(GroupName); } else { set group guest } dbg "Detected group is $group" set eval_str [list SELECT actionname,$group FROM AccessRightsTable ] set permission_list [list GroupName $group] db eval $eval_str permissions { lappend permission_list $permissions(actionname) $permissions($group) } dbg "permissions for user $user belonging to the group $group are: $permission_list" return $permission_list } proc htmlGradesTable {db permission_list user} { array set permission $permission_list global sortCol switch $permission(GroupName) { guest { } student { htmlDBout db $permission_list $user $sortCol} ta { htmlDBout db $permission_list $user $sortCol} instructor { htmlDBout db $permission_list $user $sortCol} default { } } } proc htmlDefaultView { permission_list user } { ChoseAction showcontrols $permission_list $user ChoseAction showgrades $permission_list $user } proc htmlHeader {} { puts { Grade Book } } ##################### end of procs #################################### set timestamp [clock format [clock seconds] -format "%Y-%m-%dT%H:%M:%S"] #CreateGradesTable db #CreateAccessRightsTable db dbg [::ncgi::names] 4 # logon and logoff actions are granted to everyone if { $action == "logon" } { LogMeOn; set action defaultview } if { $action == "logoff" } { LogMeOff; set action defaultview } ::ncgi::header htmlHeader puts "" set dbfile "courses/$coursedbfname" if { ($coursedbfname ne "") && [file exists $dbfile] } { sqlite3 db $dbfile dbg "===== Connection at $timestamp for user $user =====" set permission_list [AccessGroupRights db $user $password] htmlTop $permission_list ChoseAction $action $permission_list $user } else { htmlErrorMsg "No requested database {$coursedbfname}. Please, check your url" dbg "Attemt to access non existing database: {$dbfile}" } htmlFooter $permission_list puts "" # vim: ts=2 sw=2 foldmethod=indent: