- Metakit for the database
- logic and code from the formkit package
- crypt in pure tcl from the wiki for the passwords
- The Tclhttpd session module for row(record) locking and session control.
proc crypt {password salt} {to proc tclcrypt {password salt} {Save the following************ Begin fmkt.tcl ************************************************ # This an example of a username/password database for the Tclhttpd webserver.
# It uses Metakit for the database and uses ideas from formkit for
# row or record locking. It uses the session module from Tclhttpd for session
# control and crypt in pure tclfrom the wiki.
# Set up the Database
mk::file open users [Doc_Root]/dbdata/users.dat
mk::view layout users.details {user longname location phone email pass }
# Register Document type handler.
Mtype_Add .fmkt application/x-tcl-fmkt
# Set the start page that is used to launch a new session.
set Fmkt(startpage) /start.tml
# Set the time in seconds that a session will last for.
set Fmkt(age) 300
proc Doc_application/x-tcl-fmkt {path suffix sock} {
upvar #0 Httpd$sock data
global Fmkt
append data(query) ""
set queryList [Url_DecodeQuery $data(query)]
# Destroy any old session that are laying around. In this instance
# 5 minutes is the setting.
Session_Reap $Fmkt(age) Fmkt
# Find the current session (or start a new one if session=new).
set session [Session_Match $queryList Fmkt error]
if {$session == {}} {
Fmkt_ErrorPage $sock "The session no longer exists! $error"
return
}
# Process the query data from the previous page.
if [catch {FmktProcess $session $queryList} result] {
Httpd_ReturnData $sock text/html $result
return
}
# Expand the page in the correct session interpreter, or treat
# the page as ordinary html if the session has ended.
switch -exact -- $result {
0 { Httpd_ReturnFile $sock text/html $path }
1 { Doc_Subst $sock $path interp$session }
2 { Fmkt_ErrorPage $sock "This record locked by another user!" }
3 { Fmkt_ErrorPage $sock "Must enter a character!" }
4 { Fmkt_ErrorPage $sock "Record has been saved!" }
}
}
# The purpose of this procedure is to process the form query data.
# Based on the query data certain procedures are triggered.
# Parameters
# session: the session id
# query: a list of names and values produced by Url_DecodeQuery
proc FmktProcess {session query} {
global Fmkt
upvar #0 Session:$session state
set interp $state(interp)
# Process each query item.
# Some items, such as "session" and "user" are treated
# specially.
# Upon completion, zero or more of the following may occur:
# Variables and values are set in the appropriate slave
# interpreter.
# The user is defined in the state array.
# The session is destroyed.
foreach {name value} $query {
if {[string match "user" $name]} {
set user [string trim $value]
if {[string match $user ""]} {
Session_Destroy $session
return 3
} elseif {![info exist state(user)]} {
if {[Fmkt_UserLock $user]} {
Session_Destroy $session
return 2
} else {
set state(user) $user
interp eval $interp [list set user $user]
}
}
} elseif {[string match "cancel" $name] && $value} {
Session_Destroy $session
return 0
} elseif {[string match "save" $name] && $value} {
if {[Fmkt_DbSave $session $query]} {
Session_Destroy $session
return 4
} else {
return 1
}
} else {
# Define variables in the slave interpreter so they are there before
# we do a Doc_Subst on the page!
interp eval $interp [list set $name $value]
}
}
return 1
}
proc Fmkt_ErrorPage {sock error} {
global Fmkt
upvar #0 Httpd$sock data
append result "<META HTTP-EQUIV=\"REFRESH\" CONTENT=\"3;URL=$Fmkt(startpage)\">"
append result $error<BR><P>
append result " This page will redirect to the <A HREF=$Fmkt(startpage)>start page</A>"
Httpd_ReturnData $sock text/html $result
}
# Set the Formkit tag and view for the open datafile.
proc Fmkt_DbView {session db view} {
upvar #0 Session:$session state
set state(db) $db
set state(view) $view
return ""
}
# Check that the row or record is not being edited
# by another session.
proc Fmkt_UserLock {user} {
foreach id [info globals Session:*] {
upvar #0 $id session
if {[info exist session(user)]} {
if {[string match $session(user) $user]} {
return 1
}
}
}
return 0
}
# Retrieve row based on unique "user" and drop values
# in the session's slave interpreter
proc Fmkt_DbLookup {session} {
upvar #0 Session:$session state
set interp $state(interp)
if {[info exists state(errorpass)]} {
return
} else {
set position [mk::select $state(db).$state(view) -exact user $state(user)]
if {[string match "" $position]} {
foreach name [mk::view info $state(db).$state(view)] {
if {[string match "user" $name]} {
continue
} else {
interp eval $interp [list set $name ""]
}
}
} else {
set state(pass) [mk::get $state(db).$state(view)!$position pass]
foreach {name value} [mk::get $state(db).$state(view)!$position] {
interp eval $interp [list set $name $value]
}
}
unset position
interp eval $interp [list set newpass ""]
interp eval $interp [list set vfypass ""]
}
}
# Collect all the return values and check if password and verify password
# match. Crypt the password then write the values back to the database.
proc Fmkt_DbSave {session query} {
upvar #0 Session:$session state
set interp $state(interp)
lappend field_values user $state(user)
foreach {name value} $query {
if {[string match "session" $name]} {
continue
} elseif {[string match "save" $name]} {
continue
} elseif {[string match "newpass" $name]} {
set $name $value
interp eval $interp [list set $name $value]
} elseif {[string match "vfypass" $name]} {
set $name $value
interp eval $interp [list set $name $value]
} else {
set $name $value
lappend field_values $name $value
interp eval $interp [list set $name $value]
}
}
set newpass [string trim $newpass]
set vfypass [string trim $vfypass]
if {![info exists state(pass)]} {
if {[string match $newpass ""]} {
set state(errorpass) "Must enter a password!"
return 0
}
}
if {[string compare $newpass $vfypass] != 0} {
set state(errorpass) "New and Verify Passwords do not match!"
return 0
}
set position [mk::select $state(db).$state(view) -exact user $state(user)]
lappend field_values pass [Fmkt_passCrypt $newpass]
if {[string match "" $position]} {
eval mk::row append $state(db).$state(view) $field_values
} else {
eval mk::set $state(db).$state(view)!$position $field_values
}
mk::file commit $state(db)
unset field_values
return 1
}
proc Fmkt_passCrypt {newpass} {
set passcrypt [tclcrypt $newpass 91]
return $passcrypt
}
proc Fmkt_formSession {session args} {
upvar #0 Session:$session state
append result "<input type=hidden name=session value=\"$session\">"
return $result
}
proc Fmkt_errorPass {session} {
upvar #0 Session:$session state
if {[info exists state(errorpass)]} {
return $state(errorpass)
} else {
return
}
}
# Use this procedure for authentication. It is to be called from
# a .tclaccess file in the Directory you want authenticated access too.
# In the .tclaccess file put the following
# set realm "TclHttpd"
# set callback Fmkt_AuthChecker
proc Fmkt_AuthChecker {sock realm user pass} {
set row [mk::select users.details -exact user $user]
array set userdb [mk::get users.details!$row]
set salt [string range $userdb(pass) 0 1]
set passcrypt [tclcrypt $pass $salt]
if {[string compare $user $userdb(user)] == 0 &&
[string compare $passcrypt $userdb(pass)] == 0} {
return 1
} else {
return 0
}
}******************************** End fmkt.tcl ******************************The following are placed in the /htdocs directory************ Begin start.tml ****************[ Doc_Dynamic ] <!Doctype HTML PUBLIC "-//IETF//DTD HTML 2.0//EN"> <Html> <Head> <Title>Start.tml</Title> </Head> <Body> <p> This an example of a username/password database.. <p> <a HREF="page1.fmkt?session=new">Start Session</a> </Body> </Html>****************** End start.tml ************************************Begin page1.fmkt ****************
[ DbView users details ] <html> <head> <meta http-equiv="Content-Type" content="text/html; charset=windows-1252"> <title>Page1.fmkt</title> </head> <body> <H3>Add or Edit a User</H3> <form method="POST" action="page2.fmkt"> [formSession] <p><input type="submit" value="Add/Edit a Username" ><input type="text" name="user" size="25"></p> </form> <form method="POST" action="page1.fmkt"> <p> <input type="submit" value="Cancel"><input type="hidden" name="cancel"> </form> </body> </html>**************** End page1.fmkt ********************************** Begin page2.fmkt ****************
<html> <head> <meta http-equiv="Content-Type" content="text/html; charset=windows-1252"> <title>Page2.fmkt</title> </head> <body> <form method="POST" action="page2.fmkt"> [formSession] [DbLookup] <input type=hidden name=save value=1> <TABLE width=\"600\" bgcolor=\"#cc3300\" border=\"1\" cellpadding=\"3\" cellspacing=\"3\"> <TR> <TD>Username:</TD><TD>$user</TD> </TR><TR> <TD>Name:</TD><TD><INPUT type=\"TEXT\" size=\"25\" name=\"longname\" value=\"$longname\"></TD> </TR><TR> <TD>Location:</TD><TD><INPUT type=\"TEXT\" size=\"25\" name=\"location\" value=\"$location\"></TD> </TR><TR> <TD>Phone:</TD><TD><INPUT type=\"TEXT\" size=\"25\" name=\"phone\" value=\"$phone\"></TD> </TR><TR> <TD>Email:</TD><TD><INPUT type=\"TEXT\" size=\"25\" name=\"email\" value=\"$email\"></TD> </TR><TR> <TD>Enter Password:</TD><TD><INPUT type=\"PASSWORD\" size=\"25\" name=\"newpass\" value=\"$newpass\"></TD> </TR><TR> <TD>Verify Password:</TD><TD><INPUT type=\"PASSWORD\" size=\"25\" name=\"vfypass\" value=\"$vfypass\"></TD> </TR> </TABLE> <p><input type="submit" value="Save" ></p> </form> [errorPass] <form method="POST" action="page2.fmkt"> <p> <input type="submit" value="Cancel"><input type="hidden" name="cancel"> </form> </body> </html>************************ End page2.fmkt **********************************NB I've just tried this and having a bit of a problem. I first had to prepend Fmkt_ to your procs in the the three pages, and now the procs are found. Submitting from start.tml, the server just hangs....w/out error...This is on WinXP, tclhttpd3.4, and one of the latest tclkits. Custom code gets loaded, and db is created...NB OOP's I take the above back. On Jeff's advice I dropped the above into an unwrapped headsup, and things work as expected. Guess I must check my tclhttpd instal....
DKF: I was just wondering if it would wondering if it would be possible to hook up to an LDAP-hosted password database. That sort of thing is popular round here...Jeff Smith Just a thought, Squid [2] uses many types of authentication. From the Squid FAQ [3]
Authentication is actually performed outside of main Squid process. When Squid starts, it spawns a number of authentication subprocesses. These processes read usernames and passwords on stdin, and reply with "OK" or "ERR" on stdout. This technique allows you to use a number of different authentication schemes, although currently you can only use one scheme at a time. The Squid source code comes with a few authentcation processes. These include: LDAP: Uses the Lightweight Directory Access Protocol NCSA: Uses an NCSA-style username and password file. MSNT: Uses a Windows NT authentication domain. PAM: Uses the Linux Pluggable Authentication Modules scheme. SMB: Uses a SMB server like Windows NT or Samba. getpwam: Uses the old-fashioned Unix password file. In order to authenticate users, you need to compile and install one of the supplied authentication modules, one of the others, or supply your own. You tell Squid which authentcation program to use with the authenticate_program option in squid.conf. You specify the name of the program, plus any command line options if necessary. For example: authenticate_program /usr/local/squid/bin/ncsa_auth /usr/local/squid/etc/passwd''Maybe if you could somehow make Tclhttpd look like Squid to the above authentication modules it could be a solution.schlenk It is simple to authenticate against LDAP with the ldap module in tcllib, basically just try an ldap::bind with the users DN and his password.
