#!/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 if { [catch {set script_name $env(SCRIPT_NAME)} errStat] } { set script_name unknown} # ########################## procs begin ################################# proc dbg {msg {level 1}} { if { $level <=2 } { set fid [open log a+] puts $fid $msg close $fid } } set dbfile "./testdb" #set url_base sqlite3 db $dbfile proc CreatePasswordsTable {db} { db eval {CREATE TABLE PasswordsTable(UserName text, PasswordHash text, GroupName text)} set eval_str [list INSERT INTO PasswordsTable VALUES('instructor', '[::md5::md5 -hex qwerty]', 'instructor')] db eval $eval_str set eval_str [list INSERT INTO PasswordsTable VALUES('ta', '[::md5::md5 -hex qwerty]', 'ta')] db eval $eval_str set eval_str [list INSERT INTO PasswordsTable VALUES('jhn', '[::md5::md5 -hex qwerty]', 'student')] db eval $eval_str set eval_str [list INSERT INTO PasswordsTable VALUES('ale', '[::md5::md5 -hex qwerty]', 'student')] db eval $eval_str set eval_str [list INSERT INTO PasswordsTable VALUES('dan', '[::md5::md5 -hex qwerty]', 'student')] db eval $eval_str } proc CreateGradesTable {db} { db eval {CREATE TABLE GradesTable(FirstName text, LastName text, UserName text, HW01 real)} set eval_str [list INSERT INTO GradesTable VALUES('John','Lname1', 'jhn', 7)] db eval $eval_str set eval_str [list INSERT INTO GradesTable VALUES('Ale','Lname2', 'ale', 5)] db eval $eval_str set eval_str [list INSERT INTO GradesTable VALUES('Dan','Lname3', 'dan', 3)] db eval $eval_str } proc CreateAccessRightsTable {db} { db eval {CREATE TABLE AccessRightsTable(GroupName text, showgrades integer, sort integer, addcolumn integer, deletecolumn integer, renamecolumn integer, editcolumn integer, showcontrols integer)} db eval {INSERT INTO AccessRightsTable VALUES('instructor', 1, 1, 1, 1, 1, 1, 1)} db eval {INSERT INTO AccessRightsTable VALUES('ta', 1, 1, 1, 1, 1, 1, 1)} db eval {INSERT INTO AccessRightsTable VALUES('student', 1, 0, 0, 0, 0, 0, 0)} # guest should have no rights make sure that 0 is evereywhere db eval {INSERT INTO AccessRightsTable VALUES('guest', 0, 0, 0, 0, 0, 0, 0)} } proc htmlDBout {db permission_list {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 } set show_header 1 # show the table with grades set eval_str [list SELECT * FROM GradesTable ORDER BY $sort_col] set err [catch { db eval $eval_str v { if { $show_header } { set show_header 0 puts {} puts "" foreach col $v(*) { puts -nonewline "" } puts "" puts "" } else { puts "" } foreach index $v(*) { if { $index != "*" } { puts -nonewline "" } } puts "" } } errStat ] if { $err } { dbg "we should never be here if $sortCol exist in the table" 1 dbg $errStat 1 } puts "
$col" # below list has action and action_label pairs set action_list [list editcolumn edit deletecolumn delete renamecolumn rename] set separator {
} foreach {act act_label} $action_list { if { [info exist permission($act) ] } { if { $permission($act) } { puts -nonewline "$separator$act_label" } } } puts -nonewline "
$v($index)
" } proc htmlTop {permission_list} { array set permission $permission_list if { $permission(GroupName) == "guest" } { askToLogin } else { LogOffOption } } proc htmlBottom {permission_list} { array set permission $permission_list global VERSION puts "
" puts "GradeBook $VERSION code is written by Eugeniy Mikhailov" puts "
" } proc LogOffOption {} { global user password script_name puts "
" puts "You are logged in as $user do you wish to " puts "logoff" puts "
" } proc askToLogin {} { global script_name 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 {
} } #proc CheckAccessRights { user password} {} #proc IsUserknown {} {return 1} #proc SetLoginInfo {} { #global user password #set isAccessGranted [IsUserknown] #if { $isAccessGranted } { #dbg "access granted to user $user" #} #set access_rights [CheckAccessRights $user $password] #} proc LogMeOn {} { global user password set user [::ncgi::value user guest] set password [::ncgi::value password guest] dbg "Logging in and setting cookies" ::ncgi::setCookie -name user -value $user ::ncgi::setCookie -name password -value $password } proc LogMeOff {} { dbg "Logging off" 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 return 1; } if { [info exist permission($action) ] && $permission($action) } { dbg "requested action $action is granted" 4 return 1; } else { dbg "requested action $action is not granted" 4 return 0; } } proc ChoseAction {action permission_list user} { array set permission $permission_list dbg "requested action: $action" 3 if { [isActionGranted $action $permission_list $user] } { switch $action { sort { SetSortColumn; ChoseAction defaultview $permission_list $user } addcolumn { AddColumn } deletecolumn { } renamecolumn { } showcontrols { ShowControls $permission_list $user } showgrades { htmlGradesTable db $permission_list $user } defaultview { htmlDefaultView $permission_list $user } default { } } } } proc AddColumn { permission_list user } { } proc ShowControls { permission_list user } { array set permission $permission_list global script_name dbg "outputing contol list" puts "
" set action_list [ list addcolumn "Add Column" ] set separator {"_z_"} foreach {act act_label} $action_list { if { [info exist permission($act) ] } { if { $permission($act) } { puts -nonewline "$separator$act_label" } } } 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 PasswordsTable WHERE UserName='$user' AND PasswordHash='$PasswordHash'] db eval $eval_str group_name_array {} set name_found [array names group_name_array -exact GroupName] if { $name_found != ""} { set group $group_name_array(GroupName); } else { set group guest } dbg "Detected group is $group" set eval_str [list SELECT * FROM AccessRightsTable WHERE GroupName='$group'] db eval $eval_str permissions {} array unset permissions {\*} dbg "permissions for user $user belonging to the group $group are: [array get permissions]" return [array get permissions] } proc htmlStudentGrades { db user } { set defSortCol LastName global script_name set sort_col $defSortCol set show_header 1 # show the table with grades set eval_str [list SELECT * FROM GradesTable WHERE UserName='$user' ORDER BY $sort_col] set err [catch { db eval $eval_str v { if { $show_header } { set show_header 0 puts {} puts "" foreach col $v(*) { puts -nonewline "" } puts "" puts "" } else { puts "" } foreach index $v(*) { if { $index != "*" } { puts -nonewline "" } } puts "" } } errStat ] if { $err } { dbg "we should never be here if $sortCol and $user exist in the table" 1 dbg $errStat 1 } puts "
$col
$v($index)
" } proc htmlGradesTable {db permission_list user} { array set permission $permission_list global sortCol switch $permission(GroupName) { guest { } student { htmlStudentGrades db $user} ta { htmlDBout db $permission_list $sortCol} instructor { htmlDBout db $permission_list $sortCol} default { } } } proc htmlDefaultView { permission_list user } { ChoseAction showcontrols $permission_list $user ChoseAction showgrades $permission_list $user htmlBottom $permission_list } ##################### end of procs #################################### set timestamp [clock format [clock seconds] -format "%Y-%m-%dT%H:%M:%S"] #CreatePasswordsTable db #CreateGradesTable db #CreateAccessRightsTable db dbg [::ncgi::names] 4 # logon and logoff actions are granted to everyone if { $action == "logon" } { LogMeOn; set action none } if { $action == "logoff" } { LogMeOff; set action none } dbg "===== Connection at $timestamp for user $user =====" set permission_list [AccessGroupRights db $user $password] ::ncgi::header htmlTop $permission_list ChoseAction $action $permission_list $user #htmlDefaultView $permission_list $user #htmlGradesTable db $permission_list $user #htmlDBout db $sortCol