# Copyright for URLibService (c) 1995 - 2018, # by Gerald Banon. All rights reserved. # Setting the Preferences (SP) package provide dpi.inpe.br/banon/1998/08.02.08.56 2.1 # ---------------------------------------------------------------------- # SPDialog # Example 33-2 # the entry names and types are: # spLanguage .lis. # spMail .ent. # spBrowser .lis. # spPort .ent. proc SPDialog {} { # runs with start global w global homePath global environmentArray global sp global spPreferenceButton # global spUseMail global spEnableRequireUser global spUseUserAuthentication global spDocAccessPermission global spDownloadAccessPermission global spPreference global typeTable global listNameTable global spLanguageLabel spMailLabel spBrowserLabel spPortLabel global spToupper global spSettingArray global loCoInRep global spButtonList set spButtonList {language mail browser port} if ![info exists environmentArray(spEMailAddressList)] { set environmentArray(spEMailAddressList) "" } set spLanguageLabel " Language " set spMailLabel " E-Mail Address " set spBrowserLabel " Browser " set spPortLabel " Port Number " set spLanguageButtonName Language set spMailButtonName Address set spBrowserButtonName Browser set spPortButtonName Port set typeTable(spLanguage) .lis. set typeTable(spMail) .ent. set typeTable(spBrowser) .lis. set typeTable(spPort) .ent. set listNameTable(spLanguage) languageList set listNameTable(spMail) environmentArray(spEMailAddressList) set listNameTable(spBrowser) browserList set listNameTable(spPort) environmentArray(spPortList) set spToupper(language) Language set spToupper(mail) Mail set spToupper(browser) Browser set spToupper(port) Port # sp$spToupper($button) == ${spPreference}Label] SetInitialValue spPreferenceButton language set spPreference sp$spToupper($spPreferenceButton) frame $w.main set f $w.main.sp frame $f # if {$spArrayName == "environmentArray"} { foreach button $spButtonList { set entryName sp$spToupper($button) if [info exists \ environmentArray(${entryName}Entry)] { set spSettingArray(${entryName}Entry) \ $environmentArray(${entryName}Entry) } else { set spSettingArray(${entryName}Entry) {} } } # } # set W [winfo pixels $f 10c] # wm minsize $f $W 200 ;# 200 could be anything else Header $f "Setting the Preferences" ;# .sp1 frame $f.sp1 -height .1c ;# extra space set font [lindex [$f.lb configure -font] end] # menubar frame $f.menubar set width 2 set height .66 pack propagate $f.menubar false foreach button $spButtonList { frame $f.menubar.$button \ -width [format "%sc" $width] \ -height [format "%sc" $height] pack propagate $f.menubar.$button false set $button [button $f.menubar.$button.b \ -borderwidth 2 -cursor hand2 \ -command "ProcessPreferenceButtons $f $button"] set buttonName sp$spToupper($button)ButtonName eval ConfigText $$button $$buttonName eval pack $$button -fill both -expand true } # grid $f.menubar.language $f.menubar.mail # grid $f.menubar.browser $f.menubar.port grid $f.menubar.language $f.menubar.mail $f.menubar.browser $f.menubar.port # set bg [. cget -bg] # set nc [NewColor . $bg] set bg [$w cget -bg] set nc [NewColor $w $bg] $f.menubar.$spPreferenceButton.b configure -bg $nc # menubar - end # scroll forward and backward frame $f.scroll -width 1.18c -height .5c set width .59c set height .5c set buttonNames {backward forward} set forwardLabel > set backwardLabel < pack propagate $f.scroll false foreach button $buttonNames { frame $f.scroll.$button -width $width -height $height pack propagate $f.scroll.$button false pack $f.scroll.$button -side left set $button [button $f.scroll.$button.b \ -cursor hand2 \ -font {-family courier -size 11 -weight normal} \ -command "ProcessScrollButtons $f \ $button {$spButtonList}"] eval $$button config -text $${button}Label eval pack $$button -fill both -expand true } # scroll forward and backward - end frame $f.sp2 -height .4c ;# extra space # Preference # frame $f.pre -borderwidth 4 -relief groove frame $f.pre -borderwidth 2 -relief groove frame $f.pre.sp -height .2c ;# extra space label $f.lbpre -font {$font 10 roman} ConfigText $f.lbpre \ [subst $${spPreference}Label] set bg [lindex [$f configure -bg] end] set t [text $f.pre.text -wrap word -fg black \ -relief flat -bg $bg -width 60] ;# 60 = text size $spToupper($spPreferenceButton)Text $t $t configure -tabs "4.8c center" ;# 4.8c = to centre the text (it depends on the text size) $t configure -height 3 $t configure -state disabled set aPreference [Selector $f.pre spPreference sp 1 \ $listNameTable($spPreference) 0] # button4 ConfigText $aPreference.button4.4 Remove $aPreference.button4.4 configure \ -command "RemoveEntry $aPreference spPreference \ sp(result1)" ConfigText $f.pre.lb4 " Remove the Current Entry " pack propagate $aPreference.button4 false # button4 - end pack $f.pre.sp -side top ;# extra space pack $t -side top place $f.lbpre -in $f.pre -anchor center \ -relx 0.5 -y -2 # Preference - end frame $f.sp3 -height .4c ;# extra space # Permission frame $f.perm -borderwidth 2 -relief groove label $f.lbperm -font {$font 10 roman} ConfigText $f.lbperm { Permission } frame $f.perm.sp1 -height .2c ;# extra space message $f.perm.msg -width 10c -justify center ConfigText $f.perm.msg \ {Please check and/or add the default permission\ for the local collection.} SetInitialValue spDocAccessPermission {allow from all} SetInitialValue spDownloadAccessPermission {deny from all} PermissionWidget $f.perm sp $spDocAccessPermission $spDownloadAccessPermission frame $f.perm.sp2 -height .3c ;# extra space # Permission - end frame $f.sp4 -height .2c ;# extra space # Migration 5/02/2005 if [info exists environmentArray(spDaylightTime)] { unset environmentArray(spDaylightTime) } # Migration 5/02/2005 - end # if ![info exists environmentArray(spUseMail)] { # set environmentArray(spUseMail) 0 # } if ![info exists environmentArray(spEnableRequireUser)] { set environmentArray(spEnableRequireUser) 1 } if ![info exists environmentArray(spUseUserAuthentication)] { set environmentArray(spUseUserAuthentication) 0 } # set spUseMail $environmentArray(spUseMail) set spEnableRequireUser $environmentArray(spEnableRequireUser) if {[info exists loCoInRep] && [file exists $homePath/col/$loCoInRep/auxdoc/@passwords.txt]} { set spUseUserAuthentication $environmentArray(spUseUserAuthentication) } else { set spUseUserAuthentication 0 } # frame $f.check -width 8.4c frame $f.check # checkbutton $f.check.check1 -variable spUseMail checkbutton $f.check.check1 -variable spEnableRequireUser # ConfigText $f.check.check1 {Daylight Time} # ConfigText $f.check.check1 {Use Mail} ConfigText $f.check.check1 {Require User} checkbutton $f.check.check2 -variable spUseUserAuthentication ConfigText $f.check.check2 {Use User Authentication} if {![info exists loCoInRep] || \ ![file exists $homePath/col/$loCoInRep/auxdoc/@passwords.txt]} { $f.check.check2 config -state disabled } set b [Footer $f sp(ok)] pack $f.perm.sp1 -side top ;# extra space pack $f.perm.msg -side top pack $f.perm.tab -side top -padx 15 pack $f.perm.sp2 -side top ;# extra space place $f.lbperm -in $f.perm -anchor center \ -relx 0.5 -y -2 pack $f.lb -side top -pady .25c pack $f.sp1 -side top ;# extra space pack $f.menubar -side top pack $f.scroll -side top pack $f.sp2 -side top ;# extra space pack $f.pre -side top -fill x -padx .2c -pady .05c pack $f.sp3 -side top ;# extra space pack $f.perm -side top -fill x -padx .2c -pady .05c pack $f.sp4 -side top ;# extra space # pack $f.check.check1 -side top -pady .2c pack $f.check.check1 -side left pack $f.check.check2 -side right pack $f.check -side top -fill x -padx 1c pack $aPreference -padx 1c -pady .45c pack $b -side top -pady .25c # help bind $w <1> "ProcessButton1 $f" # help - end set focus $aPreference.entry pack $f -side top -fill both -expand true pack $w.main -side top -fill both -expand true -padx 14 SetGeometry CompleteEntry $f.pre.entry.entry spPreference sp(result1) check return } # SPDialog - end # ---------------------------------------------------------------------- # CheckURLibServerAccess # Test the access to the URLib local collection server proc CheckURLibServerAccess {} { global errorInfo if [catch {MultipleEval Identity 1} flag] { # access not completed set message "access not completed \n$errorInfo" } else { # access completed if [string equal {1} $flag] { set message {URLib Local Collection Server OK} } else { # access not completed # set message "access not completed - --$flag--" # set message "access not completed" ;# the string "access not completed" must be maintain for the message beeing displayed by start (see SPOK) and post set message "access not completed - maybe there is a firewall on the URLib port" ;# the string "access not completed" must be maintain for the message beeing displayed by start (see SPOK) and post } } return $message } # CheckURLibServerAccess - end # ---------------------------------------------------------------------- # SPOK # test values are 0 or 1 # 1 means just test the input syntax # 0 means execute action # called in OK (see utilities2.tcl) proc SPOK {f test} { # runs with start global environmentArray global spPreferenceButton global sp global spSettingArray global spPreference global spButtonList global typeTable # global spUseMail global spEnableRequireUser global spUseUserAuthentication global loCoInRep ;# for installation purpose global log global w global spToupper global languageTable global serverAddress global serverAddressWithIP global localSite global installInitialCollection global setPreferences ;# used by start global spPermissionText global spDocAccessPermission global spDownloadAccessPermission global homePath global loCoInRep # puts OK # Save result in the spSettingArray if {$spPreferenceButton == "mail"} { # put to lower case # mkdir / windows 95 work properly just for lower case set sp(result1) [string tolower $sp(result1)] } set spSettingArray(${spPreference}Entry) $sp(result1) # Save result in the spSettingArray - end # Check the current entry if [TestEntry $f $spPreferenceButton] {return 1} # Check the current entry - end # Check other entries foreach button $spButtonList { if [TestEntry $f $button] {return 1} } # Check other entries - end # Check permission if $test {if [ComputeAccessPermission doc $f.perm sp] {return 1}} if $test {if [ComputeAccessPermission download $f.perm sp] {return 1}} # Check permission - end # oldPortNumber # default is 1905 (see LoadGlobalVariables in utilitiesStart.tcl) set oldPortNumber $environmentArray(spPortEntry) # portNumber set portNumber $spSettingArray(spPortEntry) set environmentArray(spPortEntry) $portNumber ;# set again below (see # SET environmentArray) if {![info exists loCoInRep] && $test} { # URLibService is being installed # FindInternetAddress ;# updates environmentArray - commented by GJFB in 2010-08-13 set serverAddress [GetServerAddress] ;# set the new port for start set serverAddressWithIP [GetServerAddress 1] ;# set the new port for start set command [list list Identity $serverAddressWithIP] # MULTIPLE SUBMIT set serverAddressWithIP2 [MultipleExecute [list $serverAddressWithIP] $command 0 1] ;# scenario 0 # urlibFlag set urlibFlag [string equal $serverAddressWithIP $serverAddressWithIP2] ;# added by GJFB in 2013-05-16 - better solution when using virtual host, ortherwise apache must be down when installing a new virtual host set localSite [ReturnHTTPHost] # set convertedURL [ConvertURLToHexadecimal http://$localSite] # if ![catch {http::geturl $convertedURL} token] # ;# should not be used with virtual host ## apache server is running at this server address if $urlibFlag { # URLibService server is running at this server address set environmentArray(spPortEntry) $oldPortNumber Dialog OK disabled -1 SP {port in use} $portNumber $portNumber # set to port in order to SPDialog open with the port form set environmentArray(spPreferenceButton) port return 1 } } if {$oldPortNumber != "$portNumber"} { # port change set oldServerAddress $serverAddress set oldServerAddressWithIP $serverAddressWithIP set oldLocalSite $localSite set ipAddress $environmentArray(ipAddress) if ![regexp {:(.*)} $localSite m oldHTTPPort] { set oldHTTPPort 80 } foreach {oldServerName oldURLibPort} [ReturnCommunicationAddress $oldServerAddress] {break} set newServerAddress [GetServerAddress] set newServerAddressWithIP [GetServerAddress 1] set newLocalSite [ReturnHTTPHost $newServerAddress] if ![regexp {:(.*)} $newLocalSite m newHTTPPort] { set newHTTPPort 80 } set newLocalSiteWithIP [ReturnHTTPHost $newServerAddressWithIP] foreach {newServerName newURLibPort} [ReturnCommunicationAddress $newServerAddress] {break} # puts "test = $test" if {[info exists loCoInRep] && $test} { if {$oldURLibPort != "$newURLibPort"} { Set environmentArray(spPortEntry) $portNumber ;# needed for StartLocalURLibServer if [Eval StartLocalURLibServer] { # start server fails set environmentArray(spPortEntry) $oldPortNumber Set environmentArray(spPortEntry) $oldPortNumber Load ../auxdoc/messageForStart message Dialog OK disabled -1 SP {port in use} [lindex $message 2] $portNumber # set to port in order to SPDialog open with the port form set environmentArray(spPreferenceButton) port return 1 } } set serverAddress $newServerAddress ;# set the new port for start set serverAddressWithIP $newServerAddressWithIP ;# set the new port for start set localSite $newLocalSite # Set serverAddress $serverAddress ;# set the new port for post # Set localSite $localSite set message [CheckURLibServerAccess] # if [string equal {access not completed} $message] # ;# commented by GJFB in 2018-04-16 if [regexp {access not completed} $message] { ;# added by GJFB in 2018-04-16 # for example when using virtual host name in standalone mode Execute [list $oldServerName $newURLibPort] [list StartLocalURLibServer $oldURLibPort] ;# to return to the old port set environmentArray(spPortEntry) $oldPortNumber set serverAddress $oldServerAddress set serverAddressWithIP $oldServerAddressWithIP set localSite $oldLocalSite Set environmentArray(spPortEntry) $oldPortNumber if ![regexp {^([^ ]*) +[0-9]*$} [string trim $portNumber { }] m httpHostName] { set httpHostName $environmentArray(hostName) } set httpHostName [string tolower $httpHostName] ;# because of env(PATH_INFO) that might contain the path info in lower case Dialog OK disabled -1 SP $message $newServerName $environmentArray(ipAddress) # set to port in order to SPDialog open with the port form set environmentArray(spPreferenceButton) port return 1 } Load $homePath/@serverRoot2 serverRoot2 if {$oldLocalSite != "$localSite"} { set virtualHostConfList [glob $serverRoot2/conf/VirtualHost2/*] foreach path $virtualHostConfList { Load $path fileContent if [string equal [ReturnHTTPHost $fileContent] $localSite] { # apache server is running at this server address Set environmentArray(spPortEntry) $oldPortNumber ;# needed for StartLocalURLibServer Eval StartLocalURLibServer ;# to return to the old port set environmentArray(spPortEntry) $oldPortNumber set serverAddress $oldServerAddress set serverAddressWithIP $oldServerAddressWithIP set localSite $oldLocalSite if ![regexp {^([^ ]*) +[0-9]*$} [string trim $portNumber { }] m httpHostName] { set httpHostName $environmentArray(hostName) } set httpHostName [string tolower $httpHostName] ;# because of env(PATH_INFO) that might contain the path info in lower case Dialog OK disabled -1 SP {HTTP host in use} $httpHostName $portNumber # set to port in order to SPDialog open with the port form set environmentArray(spPreferenceButton) port return 1 } } # # # apache server is not running at this server address if {[string compare $oldHTTPPort $newHTTPPort] != 0} { # http port change if {[llength $virtualHostConfList] > 1} { # more than on virtual host are running Set environmentArray(spPortEntry) $oldPortNumber ;# needed for StartLocalURLibServer Eval StartLocalURLibServer ;# to return to the old port set environmentArray(spPortEntry) $oldPortNumber set serverAddress $oldServerAddress set serverAddressWithIP $oldServerAddressWithIP set localSite $oldLocalSite if ![regexp {^([^ ]*) +[0-9]*$} [string trim $portNumber { }] m httpHostName] { set httpHostName $environmentArray(hostName) } set httpHostName [string tolower $httpHostName] ;# because of env(PATH_INFO) that might contain the path info in lower case Dialog OK disabled -1 SP {more than one virtual host are running} $oldHTTPPort $oldHTTPPort # set to port in order to SPDialog open with the port form set environmentArray(spPreferenceButton) port return 1 } set convertedURL [ConvertURLToHexadecimal http://$newLocalSiteWithIP] if ![catch {http::geturl $convertedURL] token}] { # a virtual host is already running http::cleanup $token Set environmentArray(spPortEntry) $oldPortNumber ;# needed for StartLocalURLibServer Eval StartLocalURLibServer ;# to return to the old port set environmentArray(spPortEntry) $oldPortNumber set serverAddress $oldServerAddress set serverAddressWithIP $oldServerAddressWithIP set localSite $oldLocalSite if ![regexp {^([^ ]*) +[0-9]*$} [string trim $portNumber { }] m httpHostName] { set httpHostName $environmentArray(hostName) } set httpHostName [string tolower $httpHostName] ;# because of env(PATH_INFO) that might contain the path info in lower case Dialog OK disabled -1 SP {a virtual host is already running} $newHTTPPort $newHTTPPort # set to port in order to SPDialog open with the port form set environmentArray(spPreferenceButton) port return 1 } } } file delete $serverRoot2/conf/Listen/$oldHTTPPort # file delete $serverRoot2/conf/VirtualHost/$oldURLibPort file delete -force $serverRoot2/conf/VirtualHost file mkdir $serverRoot2/conf/VirtualHost file delete $serverRoot2/conf/VirtualHost2/$oldURLibPort # Store serverAddress $homePath/@serverAddressWithIP ;# used to restart apache Store serverAddressWithIP $homePath/@serverAddressWithIP ;# used to restart apache - added by GJFB in 2013-05-17 set urlibPort [lindex $serverAddress end] ;# added by GJFB in 2014-06-20 - reintroduced by GJFB in 2019-02-22 Store urlibPort $homePath/@urlibPort ;# used in GetServerAddressFromHTTPHost only - added by GJFB in 2014-06-20 - reintroduced by GJFB in 2019-02-22 Set environmentArray(spPortEntry) $portNumber ;# needed for StartApacheServer # puts {Start Apache} Set startApacheServer 1 Eval StartApacheServer StoreIndex # Update OAI repository data UpdateOAIRepositoryData # Update OAI repository data - end # Store serverAddress $homePath/@serverAddressWithIP ;# used to restart apache - commented by GJFB in 2013-05-17 - repeated line } } set environmentArray(spPortEntry) $oldPortNumber ;# needed when comparing again portNumber and oldPortNumber below if $test {return 0} # tested - execute action # To let insert message in the log set x 0; after 1 {set x 1}; vwait x # To let insert message in the log - end set environmentArray(spPreferenceButton) $spPreferenceButton set startApacheServer 0 # mail if [info exists environmentArray(spMailEntry)] { # not installation set mail $spSettingArray(spMailEntry) # oldMail set oldMail $environmentArray(spMailEntry) if {[info exists loCoInRep] && $oldMail != "$mail"} { Set environmentArray(spMailEntry) $mail ;# needed for InformURLibSystem and startApacheServer # puts {Start Apache} Set startApacheServer 1 Eval StartApacheServer ;# needed to update at once the value of env(SERVER_ADMIN) # Change administrator password set passwordList [GetUserData * write {encryptedpassword}] regsub {@.*$} $mail {} administratorUserName regsub {@.*$} $oldMail {} oldAdministratorUserName if ![string equal $oldAdministratorUserName $administratorUserName] { # new administrator file delete $homePath/col/$loCoInRep/auxdoc/xxx # >>> the new administrator needs to reenter its password (see: I want to update my data) # then StorePassword creates the new col/$loCoInRep/auxdoc/xxx set index [lsearch -regexp $passwordList "^$administratorUserName:"] set eMailAddress [GetUserData $administratorUserName write {e-mailaddress}] if {$index != -1 && [string equal $eMailAddress $mail]} { # new administrator found set index2 [lsearch -regexp $passwordList "^administrator:"] set passwordList [lreplace $passwordList $index2 $index2] regsub {^[^:]*:} [lindex $passwordList $index] {} key lappend passwordList administrator:$key set passwords [join $passwordList \n] # Waiting for the completion of other authentications WaitQueue SPOK authentication # Waiting for the completion of other authentications - end Store passwords $homePath/col/$loCoInRep/auxdoc/@passwords.txt LeaveQueue [pid] authentication } } # Change administrator password - end # Restart apache server set startApacheServer 1 # Restart apache server - end } } if {[lsearch -exact $environmentArray(spEMailAddressList) \ $spSettingArray(spMailEntry)] == -1} { lappend environmentArray(spEMailAddressList) \ $spSettingArray(spMailEntry) } set environmentArray(spMailSelectMenu) [UpdateList \ $typeTable(spMail) sp \ environmentArray(spMailSelectMenu) \ $spSettingArray(spMailEntry) 8 \ environmentArray(spEMailAddressList)] # port if {[lsearch -exact $environmentArray(spPortList) \ $spSettingArray(spPortEntry)] == -1} { lappend environmentArray(spPortList) \ $spSettingArray(spPortEntry) } set environmentArray(spPortSelectMenu) [UpdateList \ $typeTable(spPort) sp \ environmentArray(spPortSelectMenu) \ $spSettingArray(spPortEntry) 8 \ environmentArray(spPortList)] # SET environmentArray foreach button $spButtonList { set entryName sp$spToupper($button) ;# spPort set environmentArray(${entryName}Entry) \ $spSettingArray(${entryName}Entry) } # permission # oldSPDocAccessPermission set oldSPDocAccessPermission $environmentArray(spDocAccessPermission) # oldSPDownloadAccessPermission set oldSPDownloadAccessPermission $environmentArray(spDownloadAccessPermission) set environmentArray(spDocAccessPermission) $spDocAccessPermission set environmentArray(spDownloadAccessPermission) $spDownloadAccessPermission if {$oldSPDocAccessPermission != "$spDocAccessPermission"} { if [info exists loCoInRep] { # URLibService installed Set environmentArray(spDocAccessPermission) $spDocAccessPermission ;# needed for StartApacheServer set startApacheServer 1 } } if {$oldSPDownloadAccessPermission != "$spDownloadAccessPermission"} { if [info exists loCoInRep] { # URLibService installed Set environmentArray(spDownloadAccessPermission) $spDownloadAccessPermission ;# needed for StartApacheServer set startApacheServer 1 } } if [info exists environmentArray(spUseUserAuthentication)] { set oldSPUseUserAuthentication $environmentArray(spUseUserAuthentication) } else { set oldSPUseUserAuthentication {} } if {$oldSPUseUserAuthentication != "$spUseUserAuthentication"} { if [info exists loCoInRep] { # URLibService installed Set environmentArray(spUseUserAuthentication) $spUseUserAuthentication ;# needed for StartApacheServer set startApacheServer 1 if $spUseUserAuthentication { set robotsLineList {{User-agent: *} {Disallow: /}} set fileContent [join $robotsLineList \n] } else { Load $homePath/robots2.txt fileContent } Store fileContent $homePath/robots.txt } } if [info exists environmentArray(spEnableRequireUser)] { set oldSPEnableRequireUser $environmentArray(spEnableRequireUser) } else { set oldSPEnableRequireUser {} } if {$oldSPEnableRequireUser != "$spEnableRequireUser"} { if [info exists loCoInRep] { Set environmentArray(spEnableRequireUser) $spEnableRequireUser ;# needed for StartApacheServer set startApacheServer 1 } } if $startApacheServer { Set startApacheServer 1 Eval StartApacheServer } # set environmentArray(spUseMail) $spUseMail set environmentArray(spEnableRequireUser) $spEnableRequireUser set environmentArray(spUseUserAuthentication) $spUseUserAuthentication # Update metadataArray and repArray, and start servers # (unless loCoInRep doesn't exist (true at installation)) if {[info exists loCoInRep] && ($oldPortNumber != "$portNumber" || $oldMail != "$mail")} { # not installation but port change or mail change # Inform the URLib system Eval InformURLibSystem # Inform the URLib system - end } if {[info exists loCoInRep] && $oldPortNumber != "$portNumber"} { # not installation but port change # site set site $serverAddress # Update metadataArray and repArray # similar code in post set metadata2List [Eval GetMetadata *-0,site] # Eval RemoveMetadata $metadata2List ;# metadata2List must not be too big, otherwise Eval doesn't return - commented by GJFB in 2020-08-18 Eval RemoveMetadata2 $metadata2List ;# added by GJFB in 2020-08-18 array set localMetadataArray $metadata2List foreach i [array names localMetadataArray] { set localMetadataArray($i) $site } # Eval AddMetadata [array get localMetadataArray] ;# commented by GJFB in 2020-08-18 Eval AddMetadata2 [array get localMetadataArray] ;# added by GJFB in 2020-08-18 # Update metadataArray and repArray - end # Update the HTML target file if 0 { # not in use foreach index [Array names repositoryProperties *,targetfile] { regsub {,targetfile$} $index {} rep regsub {@.*$} $environmentArray(spMailEntry) {} administratorUserName UpdateHTMLTargetFile $rep 1 $administratorUserName } } # Update the HTML target file - end # SAVE # Eval StoreArray repositoryProperties ../auxdoc/.repositoryProperties.tcl ;# commented by GJFB in 2018-03-30 Eval SaveRepositoryProperties 1 ;# added by GJFB in 2018-03-30 # Eval StoreArray metadataArray ../auxdoc/.metadataArray.tcl w list ;# commented by GJFB in 2018-03-30 # Eval StoreArray repArray ../auxdoc/.repArray.tcl w list Set saveMetadata 1 ;# added by GJFB in 2018-03-30 Eval SaveMetadata 1 ;# added by GJFB in 2018-03-30 # SAVE - end } PutInternetAddress # Update metadataArray and repArray, and start servers - end # Compute the log LogInsert [list [list Insert $log end {new line}]] 1 0 ;# blk line LogInsert [list [list Insert $log end \ {$var1 selected as your language} \ {} $spSettingArray(spLanguageEntry)] \ [list TagAdd $log italic8 \ {$var1} -forward \ $spSettingArray(spLanguageEntry)]] 0 0 LogInsert [list [list Insert $log insert {new line}]] 0 0 LogInsert [list [list Insert $log end \ {<$var1> selected as your e-mail address} \ {} $spSettingArray(spMailEntry)] \ [list TagAdd $log fixed9 \ {<$var1>} -forward $spSettingArray(spMailEntry)]] 0 0 if {[string compare {} $spSettingArray(spBrowserEntry)] != 0} { LogInsert [list [list Insert $log insert {new line}]] 0 0 LogInsert [list [list Insert $log end \ {$var1 selected as your browser} \ {} $spSettingArray(spBrowserEntry)] \ [list TagAdd $log italic8 \ {$var1} -forward \ $spSettingArray(spBrowserEntry)]] 0 0 } LogInsert [list [list Insert $log insert {new line}]] 0 0 LogInsert [list [list Insert $log end \ {<$var1> selected as your port number} \ {} $spSettingArray(spPortEntry)] \ [list TagAdd $log fixed9 \ {<$var1>} -forward $spSettingArray(spPortEntry)]] 0 0 LogInsert [list [list Insert $log insert {new line}]] 0 0 LogInsert [list [list Insert $log end {<}] \ [list TagAdd $log fixed9 {<}]] 0 0 set blank {} foreach var1 [lreplace [split $spDocAccessPermission \n] end end] { set var1 $blank$var1 LogInsert [list [list Insert $log end {$var1} {} $var1] \ [list TagAdd $log fixed9 {$var1} -forward $var1]] 0 0 LogInsert [list [list Insert $log insert {new line}]] 0 0 set blank { } } set var1 $blank[lindex [split $spDocAccessPermission \n] end] LogInsert [list [list Insert $log end {$var1} {} $var1] \ [list TagAdd $log fixed9 {$var1} -forward $var1]] 0 0 LogInsert [list [list Insert $log end \ {> defined as the doc access permission}] \ [list TagAdd $log fixed9 {>}] \ [list TagAdd $log fixed9 {doc}]] 0 0 LogInsert [list [list Insert $log insert {new line}]] 0 0 LogInsert [list [list Insert $log end {<}] \ [list TagAdd $log fixed9 {<}]] 0 0 set blank {} foreach var1 [lreplace [split $spDownloadAccessPermission \n] end end] { set var1 $blank$var1 LogInsert [list [list Insert $log end {$var1} {} $var1] \ [list TagAdd $log fixed9 {$var1} -forward $var1]] 0 0 LogInsert [list [list Insert $log insert {new line}]] 0 0 set blank { } } set var1 $blank[lindex [split $spDownloadAccessPermission \n] end] LogInsert [list [list Insert $log end {$var1} {} $var1] \ [list TagAdd $log fixed9 {$var1} -forward $var1]] 0 0 LogInsert [list [list Insert $log end \ {> defined as the download access permission}] \ [list TagAdd $log fixed9 {>}] \ [list TagAdd $log fixed9 {download}]] 0 0 LogInsert [list [list Insert $log insert {new line}]] 0 1 # if $spUseMail # if $spEnableRequireUser { # LogInsert [list [list Insert $log end \ {Daylight Time enabled}] \ [list TagAdd $log italic8 {Daylight Time}]] 1 0 # LogInsert [list [list Insert $log end \ {mail in use}]] 0 0 LogInsert [list [list Insert $log end \ {Require User enabled}] \ [list TagAdd $log italic8 {Require User}]] 1 0 LogInsert [list [list Insert $log insert {new line}]] 0 1 } else { # LogInsert [list [list Insert $log end \ {Daylight Time disabled}] \ [list TagAdd $log italic8 {Daylight Time}]] 1 0 # LogInsert [list [list Insert $log insert {new line}]] 0 1 LogInsert [list [list Insert $log end \ {Require User disabled}] \ [list TagAdd $log italic8 {Require User}]] 1 0 LogInsert [list [list Insert $log insert {new line}]] 0 1 } if $spUseUserAuthentication { LogInsert [list [list Insert $log end \ {user authentication in use}]] 0 0 LogInsert [list [list Insert $log insert {new line}]] 0 1 } # Compute the log - end # update labels ConfigText $w.sp.dd " Depositing a Document " ConfigText $w.sp.ob " Open your Browser " ConfigText $w.sp.sp " Setting the Preferences " ConfigText $w.sp.cl " Close this Window and Leave the Servers On " ConfigText $w.sp.ex " Exit from URLibService (turns off the servers) " # update labels - end if ![info exists environmentArray(localCollectionIndexRepository)] { # Installation # Display warning message LogInsert [list [list Insert $log end {new line}]] 1 0 LogInsert [list [list Insert $log end \ {installing the initial collection ...}]] 0 0 LogInsert [list [list Insert $log insert {new line}]] 0 1 # Display warning message - end # Installation - end } # $log yview moveto 1.0 # SAVE # StoreArray environmentArray ../auxdoc/.environmentArray.tcl # StoreArray environmentArray ../auxdoc/.environmentArray2.tcl ;# backup StoreArrayWithBackup environmentArray ../auxdoc/.environmentArray.tcl ;# added by GJFB in 2010-08-05 # SAVE - end # UPDATE environmentArray catch {Eval LoadEnvironmentArray} ;# update in post application # UPDATE environmentArray - end destroy .sphelp ConfigText .window.menubar.dd.1 DD ConfigText .window.menubar.ob.1 OB ConfigText .window.menubar.sp.1 SP ConfigText .window.menubar.close.1 Close ConfigText .window.menubar.exit.1 Exit set setPreferences 0 # return 0 } # SPOK - end # ---------------------------------------------------------------------- # SPCancel proc SPCancel {f} { # runs with start global setPreferences LoadTextLog DisplayTextLog set setPreferences 0 } # SPCancel - end # ---------------------------------------------------------------------- # ProcessPreferenceButtons proc ProcessPreferenceButtons {f activeButton} { # runs with start global w global spLanguageLabel spMailLabel spBrowserLabel spPortLabel global spToupper global spPreferenceButton ;# values are language, mail, ... global spPreference ;# values are spLanguage, spMail, ... global listNameTable ;# defined in DDDialog global typeTable ;# defined in DDDialog global spSettingArray global sp # save result in the spSettingArray if {$spPreferenceButton == "mail"} { # put to lower case # mkdir / windows 95 work properly just for lower case set sp(result1) [string tolower $sp(result1)] } set spSettingArray(${spPreference}Entry) $sp(result1) # save result in the spSettingArray - end # set bg [. cget -bg] set bg [$w cget -bg] $f.menubar.$spPreferenceButton.b configure -bg $bg set spPreferenceButton $activeButton set spPreference sp$spToupper($spPreferenceButton) ;# spMail set type $typeTable($spPreference) if [regexp {\.ent\.} $type] { pack $f.pre.entry.button4 -side right } else { pack forget $f.pre.entry.button4 } # set nc [NewColor . $bg] set nc [NewColor $w $bg] $f.menubar.$spPreferenceButton.b configure -bg $nc ConfigText $f.lbpre [subst $${spPreference}Label] ;# spMailLabel $spToupper($spPreferenceButton)Text $f.pre.text ;# MailText # set entry SetEntry $f.pre.entry ${spPreference}Entry \ sp result1 spSettingArray ;# spMailEntry CompleteEntry $f.pre.entry.entry spPreference sp(result1) check } # ProcessPreferenceButtons - end # ---------------------------------------------------------------------- # ProcessScrollButtons proc ProcessScrollButtons {f activeButton spButtonList} { # runs with start global spPreferenceButton ;# values are language, mail, ... if {$activeButton == "forward"} { set newList $spButtonList lappend newList [lindex $spButtonList 0] set i [lsearch -exact $spButtonList $spPreferenceButton] incr i } else { set newList [list [lindex $spButtonList end]] set newList [concat $newList $spButtonList] set i [lsearch -exact $spButtonList $spPreferenceButton] } ProcessPreferenceButtons $f [lindex $newList $i] } # ProcessScrollButtons - end # ---------------------------------------------------------------------- # LanguageText proc LanguageText {t} { # runs with start $t configure -state normal $t delete 1.0 end TextStyles $t $t insert insert "\n\t" Insert $t insert \ {Please choose one of the existing languages.} $t configure -state disabled } # LanguageText - end # ---------------------------------------------------------------------- # MailText proc MailText {t} { # runs with start $t configure -state normal $t delete 1.0 end TextStyles $t $t insert insert "\t" Insert $t insert \ {Please enter your e-mail address.} $t insert insert "\n\t" # Insert $t insert \ {It has to be of the form: .} Insert $t insert \ {It has to be of the form:} $t insert insert "\n\t" Insert $t insert \ {.} # TagAdd $t fixed9 {} $t configure -state disabled } # MailText - end # ---------------------------------------------------------------------- # BrowserText proc BrowserText {t} { # runs with start $t configure -state normal $t delete 1.0 end TextStyles $t $t insert insert "\n\t" Insert $t insert \ {Please choose one browser.} $t configure -state disabled } # BrowserText - end # ---------------------------------------------------------------------- # PortText proc PortText {t} { # runs with start $t configure -state normal $t delete 1.0 end $t insert insert "\t" Insert $t insert \ {Please enter your port number.} $t insert insert "\n\t" Insert $t insert \ {It should be <80> or between <1905> - <6553>, or} # TagAdd $t fixed {<80>} # TagAdd $t fixed {<1905>} # TagAdd $t fixed {<6553>} $t insert insert "\n\t" Insert $t insert \ {between <800> - <65539> and preceded by the host.} # TagAdd $t fixed {<800>} # TagAdd $t fixed {<65539>} $t configure -state disabled } # PortText - end # ---------------------------------------------------------------------- # TestEntry proc TestEntry {f button} { # runs with start global spSettingArray global spLanguageLabel spMailLabel spBrowserLabel spPortLabel # global spArrayName # global log # global textLog global tcl_platform global environmentArray global installInitialCollection global col global browserList ;# set in start upvar #0 Text::enter enter upvar #0 Text::check check upvar #0 {Text:: Language } language upvar #0 {Text:: Browser } browser # test language entry if {$button == "language"} { if [regexp "^\[ \t]*$" $spSettingArray(spLanguageEntry)] { Dialog OK disabled -1 SP {the entry is empty} \ $language ProcessPreferenceButtons $f language # set spArrayName spSettingArray return 1 } return 0 } # test mail entry if {$button == "mail"} { if ![string match *?@?* \ $spSettingArray(spMailEntry)] { if [regexp "^\[ \t]*$" $spSettingArray(spMailEntry)] { set word $enter } else { set word $check } Dialog OK disabled -1 SP {address syntax error} $word ProcessPreferenceButtons $f mail # set spArrayName spSettingArray return 1 } return 0 } # test browser entry if {$button == "browser"} { if {[string compare {} $browserList] != 0} { # nonempty list of browsers if [regexp {^\s*$} $spSettingArray(spBrowserEntry)] { Dialog OK disabled -1 SP {the entry is empty} \ $browser ProcessPreferenceButtons $f browser return 1 } } return 0 } # test port entry if {$button == "port"} { if [regexp {^\s*$} $spSettingArray(spPortEntry)] { # empty field Dialog OK disabled -1 SP {port syntax error} $enter ProcessPreferenceButtons $f port return 1 } if [regexp {^[^ ]* +([0-9]*)$} [string trim $spSettingArray(spPortEntry) { }] m urlibPort] { if {$urlibPort < 800 || $urlibPort > 65539} { Dialog OK disabled -1 SP {port syntax error} $check ProcessPreferenceButtons $f port return 1 } } else { # old usage if {$spSettingArray(spPortEntry) != 80 && $spSettingArray(spPortEntry) < 1905 || $spSettingArray(spPortEntry) > 6553} { Dialog OK disabled -1 SP {port syntax error} $check ProcessPreferenceButtons $f port return 1 } } return 0 } } # TestEntry - end # ---------------------------------------------------------------------- # PermissionWidget # Example: # $parent == $f.perm # $xx == sp # $xx == xx proc PermissionWidget {parent xx docAccessPermission downloadAccessPermission \ {xxDefaultPermission 0}} { global w upvar #0 ${xx}DocPermission3 xxDocPermission3 upvar #0 ${xx}DocPermission2 xxDocPermission2 upvar #0 ${xx}DocPermission1 xxDocPermission1 upvar #0 ${xx}DownloadPermission3 xxDownloadPermission3 upvar #0 ${xx}DownloadPermission2 xxDownloadPermission2 upvar #0 ${xx}DownloadPermission1 xxDownloadPermission1 set bg [$w cget -bg] set nc [NewColor $w $bg] frame $parent.tab -bg $nc # the text widget must be place in the right most column because we # don't have control on the fill command (default seems to be fill -x) set xxPermissionText {} set xxDocPermission3 1 # if [regexp {allow from all} $docAccessPermission] ;# doesn't work when SPDialog is run twice (unknown reason) if {[string compare {allow from all} $docAccessPermission] == 0} { set xxDocPermission2 1 set xxDocPermission1 1 } else { if {[string compare {deny from all} $docAccessPermission] == 0} { set xxDocPermission2 0 set xxDocPermission1 0 } else { set xxDocPermission2 1 set xxDocPermission1 0 set xxPermissionText $docAccessPermission } } frame $parent.tab.v1 label $parent.tab.v1.h0 -font {courier 9 roman} \ -relief flat -height 1 \ -text " doc " checkbutton $parent.tab.v1.h1 -variable ${xx}DocPermission3 \ -state disabled checkbutton $parent.tab.v1.h2 -variable ${xx}DocPermission2 checkbutton $parent.tab.v1.h3 -variable ${xx}DocPermission1 set xxDownloadPermission3 1 if {[string compare {allow from all} $downloadAccessPermission] == 0} { set xxDownloadPermission2 1 set xxDownloadPermission1 1 } else { if {[string compare {deny from all} $downloadAccessPermission] == 0} { set xxDownloadPermission2 0 set xxDownloadPermission1 0 } else { set xxDownloadPermission2 1 set xxDownloadPermission1 0 set xxPermissionText $downloadAccessPermission } } frame $parent.tab.v2 label $parent.tab.v2.h0 -font {courier 9 roman} \ -relief flat -height 1 \ -text "download" checkbutton $parent.tab.v2.h1 -variable ${xx}DownloadPermission3 \ -state disabled checkbutton $parent.tab.v2.h2 -variable ${xx}DownloadPermission2 checkbutton $parent.tab.v2.h3 -variable ${xx}DownloadPermission1 frame $parent.tab.v3 label $parent.tab.v3.h0 -font {times 9 roman} \ -relief flat -height 1 ConfigText $parent.tab.v3.h0 {priority} label $parent.tab.v3.h1 -font {times 9 roman} \ -relief flat -height 1 ConfigText $parent.tab.v3.h1 {3rd} label $parent.tab.v3.h2 -font {times 9 roman} \ -relief flat -height 1 ConfigText $parent.tab.v3.h2 {2sd} label $parent.tab.v3.h3 -font {times 9 roman} \ -relief flat -height 1 ConfigText $parent.tab.v3.h3 {1st} frame $parent.tab.v4 label $parent.tab.v4.h0 -font {times 9 roman} \ -relief flat -height 1 ConfigText $parent.tab.v4.h0 {permission} frame $parent.tab.v4.h1 -relief sunken -borderwidth 1 entry $parent.tab.v4.h1.entry -font {courier 9 roman} \ -relief flat -bg $nc $parent.tab.v4.h1.entry insert 0 {deny from all} $parent.tab.v4.h1.entry configure -state disabled frame $parent.tab.v4.h2 -relief sunken -borderwidth 1 set permText [text $parent.tab.v4.h2.text \ -height 3 -bg #FFFFFF \ -relief flat \ -font {courier 9 roman} \ -yscrollcommand "$parent.tab.v4.h2.sy set"] # insert text set lineList [split $xxPermissionText \n] set lineList [lrange $lineList 1 end] $permText insert insert [join $lineList \n] scrollbar $parent.tab.v4.h2.sy -orient vert -command "$permText yview" frame $parent.tab.v4.h3 -relief sunken -borderwidth 1 entry $parent.tab.v4.h3.entry -font {courier 9 roman} \ -relief flat -bg $nc $parent.tab.v4.h3.entry insert 0 {allow from all} $parent.tab.v4.h3.entry configure -state disabled pack $parent.tab.v3 -side left -fill y pack $parent.tab.v1.h0 -side top -pady 6 # if !$xxDocDefaultPermission if !$xxDefaultPermission { pack $parent.tab.v1.h1 -side top pack $parent.tab.v1.h2 -side top -expand true pack $parent.tab.v1.h3 -side bottom } pack $parent.tab.v1 -side left -fill y pack $parent.tab.v2.h0 -side top -pady 6 # if !$xxDownloadDefaultPermission if !$xxDefaultPermission { pack $parent.tab.v2.h1 -side top pack $parent.tab.v2.h2 -side top -expand true pack $parent.tab.v2.h3 -side bottom } pack $parent.tab.v2 -side left -fill y pack $parent.tab.v3.h0 -side top -pady 6 pack $parent.tab.v3.h1 -side top -padx 3 -pady 4 pack $parent.tab.v3.h2 -side top -padx 3 -expand true pack $parent.tab.v3.h3 -side bottom -padx 3 -pady 4 pack $parent.tab.v4.h0 -side top -pady 6 pack $parent.tab.v4.h1.entry -side left -fill x -expand true pack $parent.tab.v4.h1 -side top -fill x -pady 1 pack $parent.tab.v4.h2.sy -side right -fill y pack $permText -side left -fill y pack $parent.tab.v4.h2 -side top pack $parent.tab.v4.h3.entry -side left -fill x -expand true pack $parent.tab.v4.h3 -side top -fill x -pady 1 pack $parent.tab.v4 -side left bind $parent.tab.v1.h2 "ProcessCheckDoc2 $xx $parent.tab.v1.h2" bind $parent.tab.v2.h2 "ProcessCheckDownload2 $xx $parent.tab.v2.h2" bind $parent.tab.v1.h3 "ProcessCheckDoc1 $xx $parent.tab.v1.h3" bind $parent.tab.v2.h3 "ProcessCheckDownload1 $xx $parent.tab.v2.h3" } # PermissionWidget - end # ---------------------------------------------------------------------- # ProcessCheckDoc2 proc ProcessCheckDoc2 {xx win} { # if {[string compare [lindex [$win configure -state] end] disabled] == 0} {return} upvar #0 ${xx}DocPermission2 xxDocPermission2 upvar #0 ${xx}DocPermission1 xxDocPermission1 upvar #0 ${xx}DownloadPermission2 xxDownloadPermission2 upvar #0 ${xx}DownloadPermission1 xxDownloadPermission1 if $xxDocPermission2 { set xxDownloadPermission2 0 set xxDocPermission1 0 set xxDownloadPermission1 0 } } # ProcessCheckDoc2 - end # ---------------------------------------------------------------------- # ProcessCheckDownload2 proc ProcessCheckDownload2 {xx win} { # if {[string compare [lindex [$win configure -state] end] disabled] == 0} {return} upvar #0 ${xx}DocPermission2 xxDocPermission2 upvar #0 ${xx}DownloadPermission2 xxDownloadPermission2 upvar #0 ${xx}DownloadPermission1 xxDownloadPermission1 if !$xxDownloadPermission2 {set xxDocPermission2 1} if $xxDownloadPermission2 {set xxDownloadPermission1 0} } # ProcessCheckDownload2 - end # ---------------------------------------------------------------------- # ProcessCheckDoc1 proc ProcessCheckDoc1 {xx win} { # if {[string compare [lindex [$win configure -state] end] disabled] == 0} {return} upvar #0 ${xx}DocPermission2 xxDocPermission2 upvar #0 ${xx}DocPermission1 xxDocPermission1 upvar #0 ${xx}DownloadPermission1 xxDownloadPermission1 if $xxDocPermission1 {set xxDownloadPermission1 0} if !$xxDocPermission1 {set xxDocPermission2 1} } # ProcessCheckDoc1 - end # ---------------------------------------------------------------------- # ProcessCheckDownload1 proc ProcessCheckDownload1 {xx win} { # if {[string compare [lindex [$win configure -state] end] disabled] == 0} {return} upvar #0 ${xx}DocPermission2 xxDocPermission2 upvar #0 ${xx}DocPermission1 xxDocPermission1 upvar #0 ${xx}DownloadPermission2 xxDownloadPermission2 upvar #0 ${xx}DownloadPermission1 xxDownloadPermission1 if !$xxDownloadPermission1 { set xxDocPermission2 1 set xxDownloadPermission2 1 set xxDocPermission1 1 } } # ProcessCheckDownload1 - end # ---------------------------------------------------------------------- # ComputeAccessPermission # computes the global variable ${xx}${directory}AccessPermission # directory values are doc or download # Examples: # ComputeAccessPermission doc .widget xx # ComputeAccessPermission download .window.main.sp.perm sp proc ComputeAccessPermission {directory parent xx} { regsub {d} $directory {D} directory upvar #0 ${xx}${directory}Permission2 xxDirectoryPermission2 upvar #0 ${xx}${directory}Permission1 xxDirectoryPermission1 upvar #0 ${xx}PermissionText xxPermissionText upvar #0 ${xx}${directory}AccessPermission xxDirectoryAccessPermission if $xxDirectoryPermission1 { set xxDirectoryAccessPermission {allow from all} } else { set lineList [list {deny from all}] if $xxDirectoryPermission2 { if [ParsePermission $parent $xx] {return 1} set lineList [concat $lineList [split $xxPermissionText \n]] } set xxDirectoryAccessPermission [join $lineList \n] } return 0 } # ComputeAccessPermission - end # ---------------------------------------------------------------------- # ParsePermission # Example: # ParsePermission .window.main.sp.perm sp proc ParsePermission {parent xx} { upvar #0 ${xx}PermissionText xxPermissionText set lineList {} if [winfo exists $parent.tab.v4.h2.text] { set xxPermissionText [string trim [$parent.tab.v4.h2.text get 1.0 end] \n] regsub -all "\n+" $xxPermissionText "\n" xxPermissionText regsub -all "\n+" $xxPermissionText "\n" xxPermissionText foreach line [split $xxPermissionText \n] { regsub -all { +} $line { } line set line [string trim $line] if [regexp {^$|^deny from all$} $line] {continue} if ![regexp {deny from [^ ]|allow from [^ ]} $line] { Dialog OK disabled -1 SP {syntax error} $line return 1 } lappend lineList $line } } set xxPermissionText [join $lineList \n] return 0 } # ParsePermission - end # ---------------------------------------------------------------------- # FindBrowser # browserName value is netscape, mozilla, konqueror, hotjava, internetExplorer and chrome proc FindBrowser {browserName} { global environmentArray global knownPathArray global tcl_platform set environmentArray($browserName) [SetPath $browserName] if [string equal {} $environmentArray($browserName)] { Load ../auxdoc/$browserName.txt environmentArray($browserName) if [file exists $environmentArray($browserName)] {return 0} return 1 } else { return 0 } } # FindBrowser - end # ----------------------------------------------------------------------