proc crypt {password salt} {

 proc tclcrypt {password salt} {

 # 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
     }
 }

 [
 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>

 [
 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>

 <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>