# Copyright for the URLibService (c) 1995 - 2019, # by Gerald Banon. All rights reserved. # Version 2.1 # register.tcl # used to register users for read and write # ---------------------------------------------------------------------- # Register proc Register {} { if [catch { set currentProcedureName Register global env global cgi global mirrorHomePageRep ;# defined in FindLanguage (utilities1.tcl) global homePath ;# used in SynchronizeRepository (sourceDisplayControl), LoadService, StoreService, StorePassword, SortRandomNumber and within namespace in enRegister.tcl, ... global htpasswdPath ;# used in StorePassword global administratorUserName ;# used by CreateReturnButton global localSite ;# used by Help global serverAddressWithIP ;# used by SynchronizeRepository (sourceDisplayControl) global loCoInRep ;# used by SynchronizeRepository (sourceDisplayControl) and StorePassword global loBiMiRep ;# used while executing SynchronizeRepository (sourceDisplayControl) global URLibServiceRepository ;# used while executing SynchronizeRepository (sourceDisplayControl) and SortRandomNumber (within OpenSession) # administratorUserName # used by CreateReturnButton regsub {@.*$} $env(SERVER_ADMIN) {} administratorUserName # homePath (used in StorePassword and FindLanguage) set homePath $env(DOCUMENT_ROOT) # htpasswdPath (used in StorePassword) set htpasswdPath $env(HTPASSWD_PATH) # URLibServiceRepository (used by SortRandomNumber) set URLibServiceRepository $env(URLIB_SERVICE_REP) # mirrorHomePageRepository # used in sourceDisplayControl set mirrorHomePageRepository dpi.inpe.br/banon/2000/01.23.20.24 # array set environment [array get env] ;# used in MultipleSubmit set col ../../../../.. source ../$col/$URLibServiceRepository/doc/utilities1.tcl source ../$col/$URLibServiceRepository/doc/cgi/mirrorfind-.tcl # serverAddress set serverAddress [list $env(SERVER_NAME) $env(URLIB_PORT)] # serverAddressWithIP set serverAddressWithIP [list $env(IP_ADDR) $env(URLIB_PORT)] # localSite set localSite $env(SERVER_NAME):$env(SERVER_PORT) # loCoInRep set loCoInRep $env(LOCOINREP) # loBiMiRep set loBiMiRep $env(LOBIMIREP) # currentRep (local mirror repository - contains @siteList.txt) set uri [file split $env(REQUEST_URI)] regsub -all { } [lrange $uri 2 5] {/} currentRep ;# used in mirrorHomePage.html # Find the language and the language repository # use the same languages as used for the local bibliographic mirror foreach {language languageRep1 languageRep2 firstLanguageRep \ submissionFormRep submissionFormLanguage submissionFormLanguageRep} \ [FindLanguage $currentRep] {break} # Find the language and the language repository - end # GetConversionTable $languageRep2 $language # global field::conversionTable if 0 { puts {Content-Type: text/html} puts {} } # Source displayControl.tcl set enableOutput 1 eval $sourceDisplayControl # Source displayControl.tc - end set cellFont {} # set fieldName %9 # set field _9_theme set fieldName %@subject set field __subject_subject set referenceType {Advanced User Registration} if {[info exists displayTable($referenceType,$fieldName)] && \ $displayTable($referenceType,$fieldName)} { set openComment(theme) {} set closeComment(theme) {} } else { set openComment(theme) {} } # bgColor, background and bgProperties if 0 { # used in old mirror foreach {bgColor background bgProperties fontTag fontTag2} [GetBg $languageRep1 $language] {break} set background [subst $background] } # display set display [GetFrameName] foreach {language languageRep2} [FindLanguageForSubmissionForm $language $submissionFormLanguage $firstLanguageRep $languageRep2] {break} source ../$col/$languageRep2/doc/mirror/${submissionFormLanguage}Register.tcl global "${languageRep2}::currentVariableFileName" ;# for reverse engineering global "${languageRep2}::registration header" global "${languageRep2}::footer" global "${languageRep2}::Return" global "${languageRep2}::Continue" # global "${languageRep2}::Copy" global "${languageRep2}::Print" global "${languageRep2}::Submission" global "${languageRep2}::Update" global "${languageRep2}::submission" global "${languageRep2}::update" global "${languageRep2}::user" global "${languageRep2}::advanced user" global "${languageRep2}::empty username" global "${languageRep2}::wrong username" global "${languageRep2}::unknown username" global "${languageRep2}::empty current password" global "${languageRep2}::empty password1" global "${languageRep2}::empty password2" global "${languageRep2}::wrong password" # global "${languageRep2}::nothing to update" global "${languageRep2}::existing user name" global "${languageRep2}::administrator user name" global "${languageRep2}::nothing to do" global "${languageRep2}::passwords are different" global "${languageRep2}::empty full name" global "${languageRep2}::empty e-mail address" global "${languageRep2}::empty theme" global "${languageRep2}::read user registration completed successfully" global "${languageRep2}::write user registration completed successfully" if [info exists env(QUERY_STRING)] { foreach {name value} [split $env(QUERY_STRING) &=] { set cgi([DecodeURL $name]) [DecodeURL $value] } } # puts [array get cgi] set userTable(readuser) ${user} set userTable(writeuser) ${advanced user} set queryInfo ?languagebutton=$language ;# cannot be within POST - otherwise language is lost # append queryInfo &returnbutton=$cgi(returnbutton) if ![info exists cgi(usertype)] {set cgi(usertype) readuser} if {[string compare {writeuser} $cgi(usertype)] == 0} { # write user set userType {usertype=writeuser&} set type write } else { # read user set userType {usertype=readuser&} set type read } if ![info exists cgi(formstate)] {set cgi(formstate) {}} if ![info exists cgi(fullname)] {set cgi(fullname) {}} if ![info exists cgi($field)] {set cgi($field) {}} if ![info exists cgi(session)] {set cgi(session) {}} ;# used only in the call to CheckSession if ![info exists cgi(registereduser)] {set cgi(registereduser) {no}} ;# needed with restricted submission # if ![info exists cgi(login)] {set cgi(login) {}} if ![info exists cgi(displayedfieldlist)] {set cgi(displayedfieldlist) {fullname password subject}} ;# needed when restrictedSubmission is 1 # Create cgi array # usefull to recover the filled fields after a submit error # CreateCGIArray # Create cgi array - end # puts [array names cgi] # Process Copy Button # Now: Print button for MSIE 4.01 if [info exists cgi(copybutton)] { # the submission or update has been completed successfully if $cgi(updateforregister) { set Action \$Update set action \$update set updateForRegister2 1 ;# used for the copy button (could be any value) } else { set Action \$Submission set action \$submission set updateForRegister2 0 ;# used for the copy button (could be any value) } set userName $cgi(username) set fullName [join $cgi(fullname)] set eMailAddress $cgi(__e_mailaddress_e_mailaddress) set theme $cgi($field) regsub -all { } $fullName {+} fullName2 ;# used when the copy button is pressed regsub -all { } $theme {+} theme2 ;# used when the copy button is pressed set extraPath {} if ![info exists cgi(delayedreturnbutton)] {set cgi(delayedreturnbutton) {xxx}} ;# used when the copy button is pressed - might be anything because returnbutton is no in the copy button if {[string compare {read} $type] == 0} { catch {SetFont [subst [subst ${read user registration completed successfully}]]} output } else { catch {SetFont [subst [subst ${write user registration completed successfully}]]} output } puts {Content-Type: text/html} puts {} puts $output return } # Process Copy Button - end ## Create cgi array ## usefull to recover the filled fields after a submit error CreateCGIArray ## Create cgi array - end regsub -all { } $cgi(displayedfieldlist) {+} displayedFieldList2 if 0 { puts {Content-Type: text/html} puts {} puts [array get cgi] } if [info exists cgi(formaction)] { # enter password set formAction $cgi(formaction) } else { set formAction http://$localSite/col/$currentRep/doc/mirror.cgi/Register$queryInfo } set userName [FilterEMailAddress $cgi(username)] set userName [string trim $userName] if ![info exists cgi(__e_mailaddress_e_mailaddress)] { if [regexp {^([^<\s@]+)@([^@\s>]+)$} $userName] { # login is an e-mail address set cgi(__e_mailaddress_e_mailaddress) $userName ;# new procedure - user name must be an e-mail address } else { set cgi(__e_mailaddress_e_mailaddress) {} } } set eMailAddress [FilterEMailAddress $cgi(__e_mailaddress_e_mailaddress)] ConditionalSet currentPassword cgi(codedcurrentpassword) {} ConditionalSet password1 cgi(codedpassword1) {} ConditionalSet password2 cgi(codedpassword2) {} set fullName $cgi(fullname) ConditionalSet resumeID cgi(resumeid) {} ConditionalSet orcid cgi(orcid) {} ConditionalSet CPF cgi(cpf) {} if ![string equal {} $CPF] { regsub -all {[.-]} $CPF {} CPF set CPF [format %011s [string trim $CPF]] } set theme $cgi($field) if 0 { puts {Content-Type: text/html} puts "" puts --$currentPassword-- puts
puts --$password1-- puts
puts --$password2-- puts
puts --$userName-- # return } # Check form # CheckUsernamePassword # puts [list $userName $password1 $password2 0 $type registrationform $currentPassword $cgi(formstate)] if {[string equal {} $cgi(formstate)] || \ ([info exists cgi(useraction)] && [regexp {register} $cgi(useraction)])} { set formState {} } else { set formState $cgi(formstate) } set type2 read ;# in order for a simple user to become an advanced user if [CheckSession $cgi(session) $userName] { if {$restrictedSubmission && [string equal {administrator} $userName]} { # check the currentPassword of the administrator if 0 { puts {Content-Type: text/html} puts "" puts [list $userName $currentPassword $password2 1 $type2 registrationform $currentPassword $formState] } set return [Execute $serverAddress [list CheckUsernamePassword \ $userName $currentPassword $password2 \ 1 $type2 registrationform $currentPassword \ $formState]] ;# seek in other site } else { # puts [list $userName $password1 $password2 0 $type2 registrationform $currentPassword $formState] set return [Execute $serverAddress [list CheckUsernamePassword \ $userName $password1 $password2 \ 0 $type2 registrationform $currentPassword \ $formState]] ;# seek in other site } } else { set return {} } if 0 { puts {Content-Type: text/html} puts "" puts --$return-- } # return if {[string compare {} $return] == 0} { if {[string compare {} $currentPassword] == 0} { # first submission if {[string compare {} $eMailAddress] == 0} { set return {empty e-mail address} } if {[string compare $administratorUserName $userName] == 0 && \ [string compare $env(SERVER_ADMIN) $eMailAddress] != 0} { # the user name is of the administrator but not the e-mail address set return {administrator user name} } if {[string compare {write} $type] == 0 } { if {[info exists {displayTable(Advanced User Registration,%@fullname)}] && \ $displayTable(Advanced User Registration,%@fullname) && \ [string compare {} $fullName] == 0} { set return {empty full name} } if {[info exists {displayTable($referenceType,$fieldName)}] && \ $displayTable($referenceType,$fieldName) && \ [string compare {} $theme] == 0} { set return {empty theme} } } } else { # update if {[string compare {} $password1] == 0 && \ [string compare {} $password2] == 0 && \ ([info exists {displayTable(Advanced User Registration,%@fullname)}] && \ !$displayTable(Advanced User Registration,%@fullname) || \ [string compare {} $fullName] == 0) && \ [string compare {} $eMailAddress] == 0 && \ ([info exists {displayTable($referenceType,$fieldName)}] && \ !$displayTable($referenceType,$fieldName) || \ [string compare {} $theme] == 0)} { set return {nothing to update} } } } else { if 0 { if {[string compare {wrong password} $return] != 0 && \ [regexp {^administrator$} $userName] && \ !$restrictedSubmission} { set return {wrong username} } } } # puts --$return-- # userArray if [file exists $homePath/col/$loCoInRep/auxdoc/.userArray.tcl] { source $homePath/col/$loCoInRep/auxdoc/.userArray.tcl } if {[info exists cgi(useraction)] && \ [string compare {update} $cgi(useraction)] == 0 && \ [regexp {^administrator$} $userName]} { # administrator -> administrator user name set userName $administratorUserName } if 0 { puts {Content-Type: text/html} puts "" puts --$cgi(useraction)-- puts --$cgi(displayedfieldlist)-- puts --$return-- puts --$currentPassword-- puts --$password1-- puts
puts --$userName-- } # Nothing to update # return the user data if [string equal {nothing to update} $return] { if {[info exists cgi(useraction)] && [regexp {update} $cgi(useraction)]} { # UPDATE user action if [string equal {write} $type] { # write foreach {eMailAddress fullName2 theme2} [ReturnUserData $userName write] {break} if [regexp {.*/.*/.*/.*} $fullName2] { set fullName3 {} } else { set fullName3 $fullName2 } # puts "Location: mirror.cgi/Register?languagebutton=$language&useraction=$cgi(useraction)&initialaction=$cgi(initialaction)&displayedfieldlist=$displayedFieldList2&session=[OpenSession $userName]&${userType}username=$userName&fullname=$fullName3&__e_mailaddress_e_mailaddress=$eMailAddress&$field=$theme2&formstate=nothingtoupdate&returnbutton=$cgi(returnbutton)&delayedreturnbutton=$cgi(delayedreturnbutton)&targetframe=$cgi(targetframe)®istereduser=$cgi(registereduser)&login=$cgi(login)" # puts "Location: mirror.cgi/Register?languagebutton=$language&useraction=$cgi(useraction)&initialaction=$cgi(initialaction)&displayedfieldlist=$displayedFieldList2&session=[OpenSession $userName]&${userType}username=$userName&fullname=$fullName3&resumeid=$resumeID&__e_mailaddress_e_mailaddress=$eMailAddress&$field=$theme2&formstate=nothingtoupdate&returnbutton=$cgi(returnbutton)&delayedreturnbutton=$cgi(delayedreturnbutton)&targetframe=$cgi(targetframe)®istereduser=$cgi(registereduser)&login=$cgi(login)" puts "Location: mirror.cgi/Register?languagebutton=$language&useraction=$cgi(useraction)&initialaction=$cgi(initialaction)&displayedfieldlist=$displayedFieldList2&session=[OpenSession $userName]&${userType}username=$userName&fullname=$fullName3&resumeid=$resumeID&orcid=$orcid&cpf=$CPF&__e_mailaddress_e_mailaddress=$eMailAddress&$field=$theme2&formstate=nothingtoupdate&returnbutton=$cgi(returnbutton)&delayedreturnbutton=$cgi(delayedreturnbutton)&targetframe=$cgi(targetframe)®istereduser=$cgi(registereduser)&login=$cgi(login)" # puts "Location: mirror.cgi/Register?languagebutton=$language&useraction=$cgi(useraction)&session=$cgi(session)&${userType}username=$userName&fullname=$fullName3&__e_mailaddress_e_mailaddress=$eMailAddress&$field=$theme2&formstate=nothingtoupdate&returnbutton=$cgi(returnbutton)&delayedreturnbutton=$cgi(delayedreturnbutton)&targetframe=$cgi(targetframe)®istereduser=$cgi(registereduser)&login=$cgi(login)" } else { # read foreach {eMailAddress} [ReturnUserData $userName read] {break} puts "Location: mirror.cgi/Register?languagebutton=$language&useraction=$cgi(useraction)&session=[OpenSession $userName]&${userType}username=$userName&__e_mailaddress_e_mailaddress=$eMailAddress&formstate=nothingtoupdate&returnbutton=$cgi(returnbutton)&delayedreturnbutton=$cgi(delayedreturnbutton)&targetframe=$cgi(targetframe)®istereduser=$cgi(registereduser)&login=$cgi(login)" # puts "Location: mirror.cgi/Register?languagebutton=$language&useraction=$cgi(useraction)&session=$cgi(session)&${userType}username=$userName&__e_mailaddress_e_mailaddress=$eMailAddress&formstate=nothingtoupdate&returnbutton=$cgi(returnbutton)&delayedreturnbutton=$cgi(delayedreturnbutton)&targetframe=$cgi(targetframe)®istereduser=$cgi(registereduser)&login=$cgi(login)" } } elseif {[info exists cgi(useraction)] && [regexp {register} $cgi(useraction)]} { # REGISTER user action if $restrictedSubmission { # administrator session # if {[string compare {administrator} $userName] == 0} # # puts "Location: mirror.cgi/Register?languagebutton=$language&useraction=$cgi(useraction)&session=[OpenSession $userName]&${userType}username=$userName&formstate=nothingtoupdate&returnbutton=$cgi(returnbutton)&delayedreturnbutton=$cgi(delayedreturnbutton)&targetframe=$cgi(targetframe)®istereduser=$cgi(registereduser)&login=$cgi(login)" puts "Location: mirror.cgi/Register?languagebutton=$language&useraction=$cgi(useraction)&session=[OpenSession $userName]&${userType}username=$userName&formstate=&returnbutton=$cgi(returnbutton)&delayedreturnbutton=$cgi(delayedreturnbutton)&targetframe=$cgi(targetframe)®istereduser=$cgi(registereduser)&login=$cgi(login)" } else { puts "Location: mirror.cgi/Register?languagebutton=$language&useraction=$cgi(useraction)&session=[OpenSession $userName]&${userType}username=$userName&formstate=nothingtoupdate&returnbutton=$cgi(returnbutton)&delayedreturnbutton=$cgi(delayedreturnbutton)&targetframe=$cgi(targetframe)®istereduser=$cgi(registereduser)&login=$userName" } } elseif {[info exists cgi(useraction)] && [regexp {review|seeworks} $cgi(useraction)]} { # REVIEW or SEEWORKS user action puts "Location: mirror.cgi/Register?languagebutton=$language&useraction=$cgi(useraction)&session=[OpenSession $userName]&${userType}username=$userName&formstate=nothingtoupdate&returnbutton=$cgi(returnbutton)&delayedreturnbutton=$cgi(delayedreturnbutton)&targetframe=$cgi(targetframe)®istereduser=$cgi(registereduser)&login=$userName" } else { # update document (CreateMirror) regexp {([^?]*)\?(.*)} $formAction m pathSegment querySegment # puts $querySegment # regsub {username=[^&]*} $querySegment {} querySegment ;# delete old username # regsub {session=[^&]*} $querySegment {} querySegment ;# delete old session set splitedNewQuerySegment {} foreach pair [split $querySegment {&}] { if [regexp {^username=} $pair] {continue} ;# delete old username if [regexp {^session=} $pair] {continue} ;# delete old session if [regexp {^login=} $pair] {continue} ;# delete old login - added by GJFB in 2013-07-19 lappend splitedNewQuerySegment $pair } set querySegment [join $splitedNewQuerySegment {&}] # puts "Location: $pathSegment?username=$userName&session=[OpenSession $userName]&$querySegment" puts "Location: $pathSegment?username=$userName&session=[OpenSession $userName]&login=$userName&$querySegment" } puts "" return } # Nothing to update - end if 0 { puts {Content-Type: text/html} puts "" puts --$cgi(useraction)-- puts --$return-- puts --$currentPassword-- puts --$password1-- puts --$displayedFieldList2-- puts --$userName-- puts --$administratorUserName-- puts [regsub -all {\.} $administratorUserName {_}] puts --$cgi(session)-- } set header ${registration header} if ![string equal {} $return] { # forbidenUserName and flag - used in mirror/xxRegister.tcl set flag [regsub -all {\.} $administratorUserName {_} forbidenUserName] ;# gerald.banon -> gerald_banon - . is not allowed in Linux - added by GJFB in 2016-08-03 if [string equal {} $currentPassword] { if {[string equal {unknown username} $return] && !($flag && [string equal $forbidenUserName $userName])} { # if {[string equal {unknown username} $return] && \ # ![string equal {passwordmanager} $userName] && \ # !($flag && [string equal $forbidenUserName $userName])} # ;# commented by GJFB in 2019-05-28 # user not registered and not passwordmanager and not a username with . and a forbiden username # useraction => register puts "Location: mirror.cgi/Register?languagebutton=$language&returnbutton=$cgi(returnbutton)&delayedreturnbutton=$cgi(delayedreturnbutton)&useraction=register&initialaction=$cgi(initialaction)&displayedfieldlist=$displayedFieldList2&login=$userName&usertype=$cgi(usertype)&session=$cgi(session)" puts "" return } else { # user registered - set registereduser to yes if [string equal {} $cgi(session)] { if [string equal {administrator} $userName] { # if [regexp {^(administrator|passwordmanager)$} $userName] # ;# commented by GJFB in 2019-05-28 set return {wrong username} } elseif {$flag && [string equal $forbidenUserName $userName]} { set return {wrong username} ;# added by GJFB in 2016-08-03 } else { if ![string equal {} $cgi(useraction)] { if [regexp {update|review} $cgi(useraction)] { # useraction => update or review puts "Location: mirror.cgi/Register?languagebutton=$language&returnbutton=$cgi(returnbutton)&delayedreturnbutton=$cgi(delayedreturnbutton)&useraction=$cgi(useraction)&initialaction=$cgi(initialaction)&displayedfieldlist=$displayedFieldList2&login=$userName&usertype=$cgi(usertype)®istereduser=yes" puts "" return } } else { # enter password puts "Location: mirror.cgi/Register?languagebutton=$language&returnbutton=$cgi(returnbutton)&delayedreturnbutton=$cgi(delayedreturnbutton)®istereduser=yes&login=$userName&usertype=$cgi(usertype)" puts "" return } } } } } if 0 { puts {Content-Type: text/html} puts "" puts --$return-- puts --$password1-- } if {[string compare {unknown username} $return] == 0} { set userName $cgi(username) set cgi(username) {} set cgi(login) {} } # registration error set cgi(__e_mailaddress_e_mailaddress) {} ;# new procedure (e-mail field must vanish to be updated when filling out the form again) # Make Return Button for wrong password warning set returnButton "


" # passworderror value could be anything CreateHiddenInput returnButton append returnButton "\
" # Make Return Button for wrong password warning - end set output [subst [subst [subst $[list $return]]]] if !$cgi(updateforregister) { # entering current password regsub {NAME="wrongpassword" VALUE="no"} $output \ {NAME="wrongpassword" VALUE="yes"} output } puts {Content-Type: text/html} puts {} puts $output return } # Check form - end if 0 { puts {Content-Type: text/html} puts {} puts --$cgi(useraction)-- } if [string equal {} $cgi(useraction)] { # access page puts "Location: mirror.cgi/Register?username=$cgi(username)&session=[OpenSession $cgi(username)]&languagebutton=$language&returnbutton=$cgi(returnbutton)&delayedreturnbutton=$cgi(delayedreturnbutton)®istereduser=$cgi(registereduser)&login=$cgi(username)" puts "" return } # OK puts {Content-Type: text/html} puts {} # CloseSession $cgi(session) $cgi(username) # Waiting for the completion of other authentication while {[EnterQueue [pid] authentication]} { set x 0; after 100 {set x 1}; vwait x } # Waiting for the completion of other authentication - end set store 0 if {[string compare {} $eMailAddress] != 0} { # set ${arrayName}($userName,e-mailaddress) $eMailAddress set userArray($userName,e-mailaddress) $eMailAddress set store 1 } else { # if [info exists ${arrayName}($userName,e-mailaddress)] if [info exists userArray($userName,e-mailaddress)] { # set eMailAddress [subst $${arrayName}($userName,e-mailaddress)] set eMailAddress $userArray($userName,e-mailaddress) } else { set eMailAddress {} } } if {[string compare {write} $type] == 0} { if ![string equal {} $fullName] { # set ${arrayName}($userName,fullname) $fullName set userArray($userName,fullname) $fullName set store 1 } else { # if [info exists ${arrayName}($userName,fullname)] if [info exists userArray($userName,fullname)] { # set fullName [subst $${arrayName}($userName,fullname)] set fullName $userArray($userName,fullname) } else { set fullName {} } } if ![string equal {} $resumeID] { set userArray($userName,resumeid) $resumeID set store 1 } else { if [info exists userArray($userName,resumeid)] { set resumeID $userArray($userName,resumeid) } else { set resumeID {} } } if [info exists userArray($userName,orcid)] { if [string equal {} $orcid] { # remove orcid unset userArray($userName,orcid) set store 1 } else { if ![string equal $userArray($userName,orcid) $orcid] { # change orcid set userArray($userName,orcid) $orcid set store 1 } } } else { if ![string equal {} $orcid] { # set orcid set userArray($userName,orcid) $orcid set store 1 } } if [info exists userArray($userName,cpf)] { if [string equal {} $CPF] { # remove cpf unset userArray($userName,cpf) set store 1 } else { if ![string equal $userArray($userName,cpf) $CPF] { # change cpf set userArray($userName,cpf) $CPF set store 1 } } } else { if ![string equal {} $CPF] { # set cpf set userArray($userName,cpf) $CPF set store 1 } } if ![string equal {} $theme] { # set ${arrayName}($userName,theme) $theme # set userArray($userName,theme) $theme set userArray($userName,subject) $theme set store 1 } else { # if [info exists ${arrayName}($userName,theme)] # # if [info exists userArray($userName,theme)] # if [info exists userArray($userName,subject)] { # set theme [subst $${arrayName}($userName,theme)] # set theme $userArray($userName,theme) set theme $userArray($userName,subject) } else { set theme {} } } } if 0 { # commented by GJFB in 2014-04-08 - the e-mail address login may already exists and its password should be preserve - useful when changing the administrator name (see also StorePassword) # Make a copy of the administrator data set administratorEMailAddress $env(SERVER_ADMIN) # set xxx --eMailAddress-- # Store xxx C:/tmp/bbb.txt auto 0 a if [string equal $eMailAddress $administratorEMailAddress] { # userName is administrator regsub {@.*$} $administratorEMailAddress {} administratorUserName if [string equal $administratorUserName $userName] { # login is just a user name foreach item [array names userArray $userName,*] { regsub "$userName," $item {} attributeName set userArray($eMailAddress,$attributeName) $userArray($item) } } else { # login is an e-mail address foreach item [array names userArray $eMailAddress,*] { regsub "$eMailAddress," $item {} attributeName set userArray($administratorUserName,$attributeName) $userArray($item) } } } # Make a copy of the administrator data - end } # STORE userArray and StorePassword if $store {StoreArray userArray $homePath/col/$loCoInRep/auxdoc/.userArray.tcl w list array 1} if ![string equal {} $password1] { StorePassword $userName $password1 $eMailAddress if 0 { # commented by GJFB in 2014-05-07 - redundant code - this action is included in StorePassword if {[string equal $administratorUserName $userName] && [string equal $env(SERVER_ADMIN) $eMailAddress]} { # the user is the administrator StorePassword administrator $password1 ;# administrator must have the same password } } } LeaveQueue [pid] authentication # puts [string compare {} $cgi(currentpassword)] # if {[string compare {} $cgi(currentpassword)] == 0 || \ ([info exists cgi(useraction)] && [string compare {register} $cgi(useraction)] == 0)} # if [string equal {no} $cgi(registereduser)] { set Action \$Submission set action \$submission set updateForRegister2 0 ;# used for the copy button } else { set Action \$Update set action \$update set updateForRegister2 1 ;# used for the copy button } # puts $action # puts --$cgi(session)-- set extraPath {} if [string equal {} $cgi(session)] { set cgi(session) [OpenSession $cgi(username)] # set cgi(registereduser) yes ;# commented by GJFB in 2013-01-30 to avoid the message "Your password was changed." when restrictedSubmission is 0 set currentPassword 0 } # puts $cgi(registereduser) if [string equal {read} $type] { # read catch {SetFont [subst [subst ${read user registration completed successfully}]]} output } else { # write regsub -all { } $fullName {+} fullName2 regsub -all { } $theme {+} theme2 catch {SetFont [subst [subst ${write user registration completed successfully}]]} output } puts $output # set xxx 3a-[pid] # Store xxx C:/tmp/bbb auto 0 a } m] { puts $m if 0 {global errorInfo; puts $errorInfo} } } # Register - end # ----------------------------------------------------------------------