# Copyright for the Uniform Repository Service (c) 1995 - 2025,
# by Gerald Banon. All rights reserved.
# Version 2.1
# test2
if 0 {
http://gjfb.home:1905/test2
}
# ----------------------------------------------------------------------
# TestExecute
proc TestExecute {} {
global env
global serverAddress ;# used in SetFieldValue
global serverAddressWithIP ;# used in Set
global homePath ;# used in Execute (async)
global tcl_platform
set col ../../../../..
set URLibServiceRepository $env(URLIB_SERVICE_REP)
source ../$col/$URLibServiceRepository/doc/utilities1.tcl
source ../$col/$URLibServiceRepository/doc/cgi/mirrorfind-.tcl
# serverAddressWithIP
set serverAddressWithIP [list $env(IP_ADDR) $env(URLIB_PORT)]
# serverAddress
set serverAddress [list $env(SERVER_NAME) $env(URLIB_PORT)]
# homePath
set homePath $env(DOCUMENT_ROOT)
# loCoInRep
set loCoInRep $env(LOCOINREP)
puts {Content-Type: text/plain}
puts {}
if 0 { ;# testing ReturnArrayValueFromFile
set namespacePrefix urn:doi
if [catch {Execute {gjfb 19050} [list ReturnArrayValueFromFile urlib.net/www/2025/09.08.04.08 namespacePrefixXresolverURLarray.tcl namespacePrefixXresolverURLarray $namespacePrefix] 1} m] {
global errorInfo
puts $errorInfo
} else {
puts --$m--
}
}
if 0 { ;# added by GJFB in 2025-10-04 to test readable socket when opening the m22 mirror - just the menu bar was appearing
if [catch {set versionStamp [list [Execute {bibdigital.sid.inpe.br 800} {GetVersionStamp iconet.com.br/banon/2003/05.31.10.26.45}]]} m] {
puts $m
} else {
global yclicks ;# set in Submit (see utilities1.tcl) - added by GJFB in 2025-10-04 to test readable socket
# puts "versionStamp = $versionStamp"
puts "yclicks = $yclicks - 1 means that the socket is NOT readable and 0 that the socket is readable, when accessing port 800 of bibdigital.sid.inpe.br"
}
}
if 1 {
set staticIPFlag [list [Execute $serverAddressWithIP [list ReturnStaticIPFlag] 0]]
} else {
set staticIPFlag 0
}
if 1 {
# puts "serverAddressWithIP [list $serverAddressWithIP]"
puts "serverAddress = [list $serverAddress]"
# puts "staticIPFlag = $staticIPFlag - if the value is empty it might be necessary to execute the sequence: ./unpost; ./kill; ./post &, or the script ./unpost-kill-post &"
}
if 1 {
# CreateIBI from urlib.net
puts {}
# if [string equal 0 $staticIPFlag] {set serverAddress2 urlib.net:80} else {set serverAddress2 $serverAddress} ;# still working
# if [string equal 0 $staticIPFlag] {set serverAddress2 {200.160.7.168 800}} else {set serverAddress2 $serverAddress}
# if [string equal 0 $staticIPFlag] {set serverAddress2 {2001:12ff:0:7::168 800}} else {set serverAddress2 $serverAddress} ;# works with tlc 8.6 but not with tcl 8.5: Execute (3): communication with server [2001:12ff:0:7::168 800] doesn't start (using async value 1)
# if [string equal 1 $staticIPFlag] {set serverAddress2 {2001:12ff:0:7::168 800}} else {set serverAddress2 $serverAddress} ;# if test2 is executed from urlib.net, then addr == 2001:12ff:0:7::168
if [string equal 0 $staticIPFlag] {set serverAddress2 {urlib.net 800}} else {set serverAddress2 $serverAddress}
# if [string equal 0 $staticIPFlag] {set serverAddress2 {urlib.net 800}} else {set serverAddress2 $serverAddress} ;# if test2 is executed from urlib.net, then addr == 200.160.7.168
LoadService $loCoInRep registrationPassword registrationPassword 1 1
# if [catch {Execute urlib.net:80 [list CreateIBI dpi.inpe.br/banon/1999/01.09.22.14 896322016461] 0} m] #
# if [catch {Execute urlib.net:80 [list CreateIBI dpi.inpe.br/banon/1999/01.09.22.14 896322016461] 1} m] #
if [catch {Execute $serverAddress2 [list CreateIBI $loCoInRep $registrationPassword] 1} m] {
# couldn't open socket: connection refused
# error writing "sock1884": connection refused
# error writing "sock240": socket is not connected
global errorInfo
puts --$errorInfo--
} else {
puts "rep [lindex $m 0]"
puts "ibip [lindex $m 1]"
}
}
if 1 {
# unfairAddrList
if {$tcl_platform(platform) == "unix"} {
set query [list list GetUnfairAddrList]
set result [MultipleExecute [list $serverAddress] $query 0] ;# this was fast in 2020-05-19
puts ""
puts "unfairAddrList = $result"
}
}
if 0 {
puts {doing kill-post...}
if [string equal /mnt/dados1/URLibFOTOb $homePath] {
# exec /mnt/dados1/URLibFOTOb/kill-post ../URLibFOTO/ & ;# <<< - commented by GJFB in 2020-12-25 - must be root
set kill_postMessageForPost ../URLibFOTO/
Store kill_postMessageForPost $homePath/col/$URLibServiceRepository/auxdoc/@kill-postMessageForPost ;# used in post
}
if [string equal /home/banon/URLibIBICT $homePath] {
# exec /home/banon/URLibIBICT/kill-post ../URLibUNIVAP/ & ;# <<< - commented by GJFB in 2020-12-25 - must be root
set kill_postMessageForPost ../URLibUNIVAP/
Store kill_postMessageForPost $homePath/col/$URLibServiceRepository/auxdoc/@kill-postMessageForPost ;# used in post
}
puts {kill-post done}
}
if 0 {
# simulating FindURLPropertyList
# http://urlib.net/test2
global scanAllArchivesFlag ;# used in CreateListOfibiProperties and CreateListOfibiProperties2
global stateArray ;# used in CreateListOfibiProperties and CreateListOfibiProperties2
set scanAllArchivesFlag 0
# set serverAddress2 {gjfb.home 800}
set serverAddress2 {mtc-m18.sid.inpe.br 800}
set criterionList2 {
clientinformation.ipaddress 192.168.1.32
parsedibiurl.ibi dpi.inpe.br/banon/2000/02.20.10.08
}
set command [list GetURLPropertyList $criterionList2] ;# used with USP only
set pID [CreateProcessID $command] ;# used with USP only
for {set i 1} {$i <= 10} {incr i} {
set numerOfResponses 0
set numberOfSites 1
set tokenList {}
set scenario 0
set ibiResolutionFlag 1
if [catch {RemoteExecute $serverAddress2 $command $scenario CreateListOfibiProperties2 {} $pID $ibiResolutionFlag} token] {
incr numerOfResponses
} else {
global $token
lappend tokenList $token
}
set flag 1 ;# enable while
set time 0
while {$flag} {
set xWaitQueue 0; after 100 {set xWaitQueue 1}; vwait xWaitQueue
incr time 100
foreach token $tokenList {
if [info exists stateArray($token)] {
# puts ($token) ;# nice puts
# puts $stateArray($token) ;# nice puts
if !$scanAllArchivesFlag {
if {$stateArray($token) == 1} {set flag 0; break} ;# the required item has been found
}
if $stateArray($token) {
incr numerOfResponses
set stateArray($token) 0 ;# set to 0 in order to incr numerOfResponses only once while the while is running
if {$numerOfResponses == $numberOfSites} {set flag 0; break} ;# all the sites have been processed
}
}
}
if {$time > 7000} {set flag 0} ;# time-out (3s + 4s) - 3s is timeout for http::geturl - 4s is to let Apache server respond
}
set listOfibiProperties {}
foreach token $tokenList {
# puts --[http::data $token]-- ;# data is empty when status is not ok
# puts [http::status $token]
# puts $xWaitQueue
# USP
if [string equal {ok} [set ${token}(status)]] {
# puts $token
set ibiProperties [set ${token}(data)]
# puts --$ibiProperties--
CleanUp $token
if [info exists stateArray($token)] {unset stateArray($token)}
if [regexp {^<} $ibiProperties] {
# ibiProperties contains an error message
} else {
# norm simplification (part of the implementation not needed)
if 1 {
set listOfibiProperties [concat $listOfibiProperties $ibiProperties]
} else {
lappend listOfibiProperties $ibiProperties
}
}
}
}
CleanUpTable $pID
puts {
}
puts $listOfibiProperties
puts {
}
}
}
if 0 {
# testing DisplayNumberOfEntries
# http://bibdigital.sid.inpe.br/test2
# the link of the number of entries are broken because the bibliographic mirror of mtc-m18.sid.inpe.br doesn't exist in gjfb.home
global siteList
global currentRep
global language
global languageRep1
global languageRep2
# global errorInfo
source ../$col/$URLibServiceRepository/doc/utilities3.tcl
# set siteList {{gjfb.home 800}}
# set currentRep dpi.inpe.br/banon/1999/06.19.17.00
set siteList {{mtc-m18.sid.inpe.br 800}}
set currentRep sid.inpe.br/mtc-m18@80/2008/03.17.15.17.24
set language en
set languageRep1 dpi.inpe.br/banon/1999/05.03.22.11
set languageRep2 dpi.inpe.br/banon/1999/05.03.22.11
set searchExpression {ref journal and y 2008}
# set searchExpression {ref thesis and course SER-SPG-INPE-MCT-BR and date 2008 and not date *-07-*}
# set searchExpression {gr *-INPE-MCT-BR and {{y 2008 and {{secondaryty p* and ref journal} or {secondaryty l* and not ref section} or secondaryty MAN or secondaryty NTC or secondaryty PUD or {ref report and not secondaryty TAE} or {secondaryty l* and ref section} or {secondaryty c* and ref conference and not booktitle, Resumos and not booktitle, Abstracts} or {ref audiovisual and not par *} or ref program}} or {ref source and not nextedition, * and repos *2008* and {not year, * or year, 2008}}} or {date 2008 and ref thesis and course *-SPG-INPE-MCT-BR and not date *-07-*}}
for {set i 1} {$i <= 30} {incr i} {
if [catch {DisplayNumberOfEntries "$searchExpression or k xx$i"} m] {
# puts $errorInfo
puts $m
} else {
puts $m
}
}
}
if 0 {
# testing remote execution of DisplayNumberOfEntries
# http://bibdigital.sid.inpe.br/test2
# the link of the number of entries are broken because the bibliographic mirror of mtc-m18.sid.inpe.br doesn't exist in gjfb.home
# not in use but tested (DisplayNumberOfEntries3 must be added in allowedCommandList)
set siteList {{mtc-m18.sid.inpe.br 800}}
set currentRep sid.inpe.br/mtc-m18@80/2008/03.17.15.17.24
set language en
set languageRep1 dpi.inpe.br/banon/1999/05.03.22.11
set languageRep2 dpi.inpe.br/banon/1999/05.03.22.11
set searchExpression {ref journal and y 2008}
set accent no
set case no
set useStoredValue 1
set subsetOfGroups {}
set integerWithLink 1
set m [Execute $serverAddress [list DisplayNumberOfEntries3 $searchExpression $accent $case $useStoredValue $subsetOfGroups $integerWithLink $siteList $currentRep $language $languageRep1 $languageRep2]]
puts $m
}
if 0 {
# testing communication
set query [list list Identity OK]
# set query [list list Identity {}] ;# => ----
# set query [list list Identity {{} {}}] ;# => ----
# set query [list list Identity {{{} {}}}] ;# => --{{} {}}--
# set query [list list Identity {{} B}] ;# => ----
# set query [list list Identity {A {}}] ;# => --A--
# set query [list list Identity {A B}] ;# => --A--
# set query [list list Identity {{A B}}] ;# => --{A B}--
# set query [list list Identity {{A B} {C D}}] ;# => --{A B}--
# set result [MultipleExecute [list {urlib.net 800}] $query 0] ;# this was very slow in 2020-05-19 - DNS servers for urlib.net are not responding to AAAA queries - see also DNSViz tool at https://dnsviz.net/ - https://dnsviz.net/d/urlib.net/dnssec/
# set result [MultipleExecute [list {200.160.7.168 800}] $query 0] ;# this was fast in 2020-05-19
# set result [MultipleExecute [list {200.160.7.241 800}] $query 0] ;# ibi.nic.br
set result [MultipleExecute [list {gjfb 19050}] $query 1] ;# ibi.nic.br
puts --$result--
}
if 0 {
# testing communication
set query1 [list list Identity OK1]
# set result [MultipleExecute [list {gjfb.home 800}] $query1 0] ;# works
# set result [MultipleExecute [list {gjfb.home 800}] $query1 1]
set result [MultipleExecute [list {vaio 19050}] $query1 0]
set result1 [MultipleExecute [list {vaio 19050}] $query1 1]
set result2 [MultipleExecute [list {vaio 19050}] $query1 2]
# set result [MultipleExecute [list {mtc-m16.sid.inpe.br 800}] $query1 1]
# set result [MultipleExecute [list {mtc-m16c.sid.inpe.br 804}] $query1 1]
# set result [MultipleExecute [list {mtc-m16b.sid.inpe.br 802}] $query1 1]
# set result [MultipleExecute [list {mtc-m21b.sid.inpe.br 804}] $query1 1]
puts --$result--
puts --$result1--
puts --$result2--
set result [MultipleExecute [list {licuri.ibict.br 800}] $query1 0]
# set result1 [MultipleExecute [list {licuri.ibict.br 800}] $query1 1]
# set result2 [MultipleExecute [list {licuri.ibict.br 800}] $query1 2]
puts --$result--
}
if 0 {
proc ReturnEmpty {} {
return
}
package require http ;# see online manual
# set url http://gjfb:1905/GetProgress
# set url http://urlib.net/GetProgress
set url http://licuri.ibict.br/GetProgress
puts [catch {http::geturl [ConvertURLToHexadecimal $url]}]
# => 1 if licuri is down
puts [catch {http::geturl [ConvertURLToHexadecimal $url] -command ReturnEmpty -timeout 3000}]
# puts [catch {http::geturl http://urlib.net/col/dpi.inpe.br/banon/2004/02.16.09.30.00/doc/@siteList.txt} token]
}
if 0 {
# testing communication: port and host name
# http://urlib.net/test2
set query0 [list list Identity OK0]
set query1 [list list Identity OK1]
# set result [MultipleExecute [list {gjfb.home 800}] $query1 0] ;# works
# set result [MultipleExecute [list {gjfb.home 800}] $query1 1]
# set result [MultipleExecute [list {vaio 19050}] $query1 1]
# puts --$result--
# set result [MultipleExecute [list {mtc-m16.sid.inpe.br 800}] $query1 1]
# set result [MultipleExecute [list {mtc-m16c.sid.inpe.br 804}] $query1 1]
# set result [MultipleExecute [list {mtc-m16b.sid.inpe.br 802}] $query1 1]
# set result [MultipleExecute [list {mtc-m21b.sid.inpe.br 804}] $query1 1]
set list {{mtc-m16d.sid.inpe.br 806} sid.inpe.br/mtc-m19@80/2009/08.21.17.02 150.163.34.248 USP 2016:06.16.19.18.35 clayton.martins@inpe.br 1x
{marte.sid.inpe.br 800} dpi.inpe.br/banon/2003/12.10.19.30 150.163.34.241 USP 2016:11.13.22.19.19 banon@dpi.inpe.br 1x
{bibdigital.sid.inpe.br 800} sid.inpe.br/bibdigital@80/2006/04.07.15.50 150.163.34.247 USP 2017:01.24.00.56.07 banon@dpi.inpe.br 1x
{marte3.sid.inpe.br 804} sid.inpe.br/banon/2001/04.03.15.36 150.163.34.241 USP 2016:06.14.04.44.58 banon@dpi.inpe.br 1x
{mtc-m16b.sid.inpe.br 802} cptec.inpe.br/walmeida/2003/04.25.17.12 150.163.34.248 USP 2016:06.14.04.44.58 banon@dpi.inpe.br 1x
{md-m09.sid.inpe.br 800} sid.inpe.br/banon/2001/03.09.09.16 150.163.34.250 USP 2016:06.16.19.18.35 banon@dpi.inpe.br 1x
{sibgrapi.sid.inpe.br 800} sid.inpe.br/banon/2001/03.30.15.38 150.163.34.245 USP 2017:03.03.02.06.52 banon@dpi.inpe.br sibgrapi.sid.inpe.br 1x
{plutao.sid.inpe.br 800} dpi.inpe.br/plutao@80/2008/08.19.15.01 150.163.34.239 USP 2017:02.08.12.34.48 banon@dpi.inpe.br 1x
{mtc-m16c.sid.inpe.br 804} sid.inpe.br/mtc-m18@80/2008/03.17.15.17 150.163.34.248 USP 2016:06.14.04.44.58 banon@dpi.inpe.br 1x
{gprb0705.sid.inpe.br 802} bighost.com.br/gabi_sf/2005/12.11.22.35 150.163.34.245 USP 2017:03.02.00.28.14 gabibanon@usp.br {} 1x
{mtc-m16.sid.inpe.br 800} sid.inpe.br/banon/2003/08.15.17.40 150.163.34.248 USP 2016:06.14.04.44.58 banon@dpi.inpe.br 1x
{mtc-m12.sid.inpe.br 800} sid.inpe.br/banon/2001/04.06.10.52 150.163.34.249 USP 2016:08.06.05.15.15 banon@dpi.inpe.br 1x
{marte2.sid.inpe.br 802} dpi.inpe.br/marte2/2013/05.17.15.03.06 150.163.34.241 USP 2016:06.14.04.44.58 banon@dpi.inpe.br 1x
{mtc-m21b.sid.inpe.br 804} sid.inpe.br/mtc-m21b/2013/09.26.14.25.20 150.163.34.239 USP 2017:03.06.16.30.49 banon@dpi.inpe.br {} 1x
{mtc-m21c.sid.inpe.br 806} urlib.net/www/2017/11.22.19.04 150.163.34.239 USP 2017:03.06.16.30.49 banon@dpi.inpe.br {} 1x
{banon-pc.dpi.inpe.br 19050} dpi.inpe.br/banon/2001/01.11.16.21 150.163.2.175 USP 2017:02.07.12.52.01 banon@dpi.inpe.br 1x
{gjfb0520.sid.inpe.br 804} dpi.inpe.br/banon/2001/02.23.19.23 150.163.34.245 USP 2017:03.09.13.51.10 banon@dpi.inpe.br {} 1x
{mtc-m21.sid.inpe.br 802} sid.inpe.br/mtc-m21/2012/06.05.15.34.39 150.163.34.239 USP 2016:06.14.04.44.58 banon@dpi.inpe.br 1}
set list {{mtc-m16d.sid.inpe.br 806} sid.inpe.br/mtc-m19@80/2009/08.21.17.02 150.163.34.248 USP 2016:06.16.19.18.35 clayton.martins@inpe.br 1x
{gprb0705.sid.inpe.br 802} bighost.com.br/gabi_sf/2005/12.11.22.35 150.163.34.245 USP 2017:03.02.00.28.14 gabibanon@usp.br {} 1x
{gjfb0520.sid.inpe.br 804} dpi.inpe.br/banon/2001/02.23.19.23 150.163.34.245 USP 2017:03.09.13.51.10 banon@dpi.inpe.br {} 1x
{md-m09.sid.inpe.br 800} sid.inpe.br/banon/2001/03.09.09.16 150.163.34.250 USP 2016:06.16.19.18.35 banon@dpi.inpe.br 1x
{mtc-m21b.sid.inpe.br 804} sid.inpe.br/mtc-m21b/2013/09.26.14.25.20 150.163.34.239 USP 2017:03.06.16.30.49 banon@dpi.inpe.br {} 1x
{mtc-m21c.sid.inpe.br 806} urlib.net/www/2017/11.22.19.04 150.163.34.239 USP 2017:03.06.16.30.49 banon@dpi.inpe.br {} 1x
{mtc-m21.sid.inpe.br 802} sid.inpe.br/mtc-m21/2012/06.05.15.34.39 150.163.34.239 USP 2016:06.14.04.44.58 banon@dpi.inpe.br 1}
set list {{mtc-m16d.sid.inpe.br 806} sid.inpe.br/mtc-m19@80/2009/08.21.17.02 150.163.34.248 USP 2016:06.16.19.18.35 clayton.martins@inpe.br 1x
{licuri.ibict.br 800} urlib.net/www/2017/10.16.01.16 200.130.45.21 USP 2016:06.14.04.44.58 banon@dpi.inpe.br 1}
set list {{mtc-m16d.sid.inpe.br 806} sid.inpe.br/mtc-m19@80/2009/08.21.17.02 150.163.34.248 USP 2016:06.16.19.18.35 clayton.martins@inpe.br 1x
{www.urlib.net 800} dpi.inpe.br/banon/2004/02.16.09.29 200.160.7.168 USP 2016:06.14.04.44.58 banon@dpi.inpe.br 1x
{licuri.ibict.br 800} urlib.net/www/2017/10.16.01.16 200.130.45.21 USP 2016:06.14.04.44.58 banon@dpi.inpe.br 1}
set length 0
foreach item [split $list x] {
foreach serverAddress $item {break}
set length2 [string length $serverAddress]
if {$length < $length2} {set length $length2}
}
puts "OK0: [list $env(SERVER_NAME) $env(URLIB_PORT)] -> tested server (using IP)"
puts "OK1: [list $env(SERVER_NAME) $env(URLIB_PORT)] -> tested server (using DN)"
puts "OK2: [list $env(SERVER_NAME) $env(URLIB_PORT)] -> {urlib.net 800} -> tested server (using IP)"
puts "OK3: [list $env(SERVER_NAME) $env(URLIB_PORT)] -> {urlib.net 800} -> tested server (using DN)"
puts "OK4: [list $env(SERVER_NAME) $env(URLIB_PORT)] -> tested server (using DN) -> tested server (using IP)"
puts "OK5: [list $env(SERVER_NAME) $env(URLIB_PORT)] -> tested server (using DN) -> tested server (using DN)"
foreach item [split $list x] {
foreach {serverAddress loCoInRep ip} $item {break}
set length2 [string length $serverAddress]
set serverAddress2 $serverAddress
append serverAddress2 [string repeat { } [expr $length - $length2 + 3]]
foreach {host port} $serverAddress {break}
set result0 [MultipleExecute [list [list $ip $port]] $query0 1]
if [string equal {} $result0] {set result0 { }}
set result1 [MultipleExecute [list $serverAddress] $query1 1]
if [string equal {} $result1] {set result1 { }}
set query2 [list list Identity2 [list $ip $port] OK2]
set result2 [MultipleExecute [list {urlib.net 800}] $query2 1]
if [string equal {} $result2] {set result2 { }}
set query3 [list list Identity2 $serverAddress OK3]
set result3 [MultipleExecute [list {urlib.net 800}] $query3 1]
if [string equal {} $result3] {set result3 { }}
set query4 [list list Identity2 [list $ip $port] OK4]
set result4 [MultipleExecute [list $serverAddress] $query4 1]
if [string equal {} $result4] {set result4 { }}
set query5 [list list Identity2 $serverAddress OK5]
set result5 [MultipleExecute [list $serverAddress] $query5 1]
if [string equal {} $result5] {set result5 { }}
foreach {host ip} [Execute {urlib.net 800} [list ReturnFullServerNameIP $host]] {break}
puts "tested server: $serverAddress2 [list $result0] [list $result1] [list $result2] [list $result3] [list $result4] [list $result5] $ip"
}
}
if 0 {
# set query [list list UpdateSiteList {{gjfb.home 800} dpi.inpe.br/banon/1999/01.09.22.14 192.168.1.31 USP 2014:10.04.01.25.28 gerald.banon@gmail.com} 896322016461 0]
set query [list list UpdateSiteList {{gjfb 19050} dpi.inpe.br/banon/1999/01.09.22.14 192.168.1.31 USP 2014:10.04.01.25.28 gerald.banon@gmail.com} 896322016461 0]
# set query [list list UpdateSiteList {{licuri.ibict.br 800} urlib.net/www/2017/10.16.01.16 200.130.45.21 USP 2014:10.04.01.25.28 banon@dpi.inpe.br} xxxxxxxxxxxx 0]
set staticIPFlag [MultipleExecute [list {www.urlib.net 800}] $query 1]
puts --$staticIPFlag--
# => --{0 {}}-- ;# gjfb
# => ---- :# licuri
}
if 0 {
# set urlibServiceSiteWithIP [Execute urlib.net GetURLibServiceSiteWithIP] ;# commented by GJFB in 2021-10-25 - sometimes fails to return nonempty result and seems to disturb the result of the above CreateIBI
set urlibServiceSiteWithIP [Execute urlib.net GetURLibServiceSiteWithIP 0] ;# added by GJFB in 2021-10-25
puts --$urlibServiceSiteWithIP--
}
# EnterQueue TestExecute
# LeaveQueue
if 0 {
# display number of not writable sites
set pwd [pwd]
cd $homePath/col/$URLibServiceRepository/auxdoc/listOfNotWritableSites
set nameList [glob -nocomplain *]
cd $pwd
# puts --$nameList--
puts "number of not writable sites = [llength $nameList]
"
foreach name [lsort $nameList] {
Load $homePath/col/$URLibServiceRepository/auxdoc/listOfNotWritableSites/$name queueLength
puts "$name = $queueLength
"
}
}
if 0 {
# generating the command:
# GetMetadataRepositories dpi.inpe.br/banon/2003/12.10.19.30.54 3 {conferencen 12 and { author Meneses,_Paulo_Roberto, }} yes yes 0 metadatalastupdate repArray xxxxxx {} 11 {}
proc Command {token} {
global listOfReturns
upvar #0 $token state
set return $state(body)
set listOfReturns [concat $listOfReturns $return]
}
global listOfReturns
package require http ;# see online manual
# set url http://banon-pc3/col/dpi.inpe.br/banon/1999/06.19.17.00/doc/mirrorsearch.cgi?query=ti+IBI&accent=yes&case2=yes&codedpassword1=xxxxxx
set url http://marte.dpi.inpe.br/col/dpi.inpe.br/banon/2003/12.10.19.30.54/doc/mirrorsearch.cgi?query=conferencen+12+and+{author+Meneses,_Paulo_Roberto,}&accent=yes&case2=yes&codedpassword1=xxxxxx
for {set i 1} {$i <= 2} {incr i} {
if [catch {http::geturl [ConvertURLToHexadecimal $url]} token] {
} else {
# geturl returned
# puts [http::data $token]
puts OK
}
}
set listOfReturns {}
for {set i 1} {$i <= 8} {incr i} {
if [catch {http::geturl [ConvertURLToHexadecimal $url] -command Command}] {
} else {
# geturl returned
}
}
after 14000 {set xWaitQueue 1}; vwait xWaitQueue
puts --$listOfReturns--
}
if 0 {
# testing CreateOptionListForCopyright
# SetFieldValue is not completed when run in mtc-m19,
# and banon-pc3 is started enabling wireless, then posting URLibService (150.163.3.97), and then plugging the network cable
set siteList [list $serverAddressWithIP {150.163.2.174 800}]
set query {automatic} ;# drop the repositories that have parents (they contain copyright translation)
puts $query
set siteMetadataRepList [FindMetadataRepositories $query 0 $siteList {} no no 1] ;# {site rep-i} {site rep-i} ...
# return banon-pc3 (without domain name)
puts --$siteMetadataRepList--
# SetFieldValue $site ${rep-i} {citationkey repository} ;# once, running in mtc-m19, SetFieldValue {banon-pc3.dpi.inpe.br 800} didn't respond, producing a blank submission/update form
# SetFieldValue {banon-pc3 800} iconet.com.br/banon/2010/02.13.15.02.51-0 {citationkey repository} 0 ;# from mtc-m19.sid.inpe.br, one gets "Concluido" but doesn't complete the script
# SetFieldValue {150.163.3.97 800} iconet.com.br/banon/2010/02.13.15.02.51-0 {citationkey repository} 0 ;# from mtc-m19.sid.inpe.br, one gets "Recebendo dados de mtc-m19.sid.inpe.br ..." and doesn't complete the script
# SetFieldValue {150.163.3.97 800} iconet.com.br/banon/2010/02.13.15.02.51-0 {citationkey repository} 1 ;# from mtc-m19.sid.inpe.br, one gets "Concluido" but doesn't complete the script
SetFieldValue {150.163.2.174 800} iconet.com.br/banon/2010/02.13.15.02.51-0 {citationkey repository} 0 ;# from mtc-m19.sid.inpe.br, works
puts {
}
puts $citationkey
puts $repository
}
if 0 {
# testing GetServerAddressFromHTTPHost
if [catch {Execute $serverAddressWithIP [list GetServerAddressFromHTTPHost mtc-m16d.sid.inpe.br]} site] {
global errorInfo
puts [set errorInfo]
}
set query {id 83LX3pFwXQZeBBx/AryH} ;# Restauração de imagens NOAA por morfologia matemática
puts $site
# => mtc-m16d.sid.inpe.br 806
}
if 0 {
# testing FindMetadataRepositories
set siteList {{mtc-m12.sid.inpe.br 800} {sibgrapi.sid.inpe.br 802} {gjfb0520.sid.inpe.br 806}}
set query {id 83LX3pFwXQZeBBx/AryH} ;# Restauração de imagens NOAA por morfologia matemática
puts $query
set siteMetadataRepList [FindMetadataRepositories $query 0 $siteList {} no no 1] ;# {site rep-i} {site rep-i} ...
puts --$siteMetadataRepList--
# => --{{gjfb0520.sid.inpe.br 806} sid.inpe.br/banon/2001/03.30.15.38.37-0} {{sibgrapi.sid.inpe.br 802} sid.inpe.br/banon/2001/03.30.15.38.37-0} {{mtc-m12.sid.inpe.br 800} sid.inpe.br/banon/2001/03.30.15.38.37-0}--
foreach element $siteMetadataRepList {
foreach {site rep-i} $element {break}
SetFieldValue $site ${rep-i} {repository}
if [Execute $site [list GetDocumentState $repository]] {puts --$site--; break} ;# show the site containing the matriz
}
# => sibgrapi.sid.inpe.br 802
}
if 0 {
set serverAddress {gjfb.home 800}
set metadataRep [Execute $serverAddress [list FindMetadataRep urlib.net/www/2014/12.26.03.36]]
puts --$metadataRep--
}
if 0 {
set serverAddress {gemini.dpi.inpe.br 800}
set metadataRep [Execute $serverAddress [list FindMetadataRep dpi.inpe.br/Gemini@80/2006/04.05.15.27]]
puts --$metadataRep--
}
if 0 {
set serverAddressWithIP {192.168.1.100 800}
set nameList [Execute $serverAddressWithIP [list GetMetadataArrayNames dpi.inpe.br/banon/2000/12.04.16.26-1,*]]
puts --$nameList--
}
if 0 {
# CreateIBI from local server (meaningful just for a server having a domain name)
if [catch {Execute $serverAddressWithIP [list CreateIBI dpi.inpe.br/banon/1999/01.09.22.14 896322016461] 0} m] {
# couldn't open socket: connection refused
# error writing "sock1884": connection refused
# error writing "sock240": socket is not connected
global errorInfo
puts $errorInfo
} else {
puts $m
}
}
if 0 {
if [catch {Execute $serverAddressWithIP [list CreateIBI2 2010/07.20.01.14.50] 0} m] {
global errorInfo
puts $errorInfo
} else {
puts $m
}
}
#
if 0 {
if [catch {Execute urlib.net:80 [list CreateIBI usp.br/gabibanon/2006/01.22.09.19 835468106996] 0} m] {
# couldn't open socket: connection refused
# error writing "sock1884": connection refused
# error writing "sock240": socket is not connected
global errorInfo
puts $errorInfo
} else {
puts $m
}
}
if 0 {
if [catch {Execute urlib.net:80 [list CreateIBI usp.br/gabibanon/2010/06.18.00.53 9460348079561043] 0} m] {
# couldn't open socket: connection refused
# error writing "sock1884": connection refused
# error writing "sock240": socket is not connected
global errorInfo
puts $errorInfo
} else {
puts $m
}
}
if 0 {
if [catch {Execute urlib.net:80 [list CreateIBI {} 974238770142] 0} m] {
# couldn't open socket: connection refused
# error writing "sock1884": connection refused
# error writing "sock240": socket is not connected
global errorInfo
puts $errorInfo
} else {
puts $m
}
}
if 0 {
if [catch {Execute $serverAddressWithIP [list TestExecute OK] 0} m] {
# couldn't open socket: connection refused
# error writing "sock1884": connection refused
# error writing "sock240": socket is not connected
global errorInfo
puts $errorInfo
} else {
puts $m
}
}
if 0 {
puts [encoding system]
puts "é
"
puts [encoding convertfrom utf-8 "é"]
}
if 0 {
# testing socket communication
global x y ;# for unix
puts 1
set s [socket -async $env(IP_ADDR) $env(URLIB_PORT)]
# set s [socket -async hermes.dpi.inpe.br 19050]
# set s [socket -async mtc-m19.sid.inpe.br 800]
fconfigure $s -buffering line
puts 2
if [info exists x] {unset x}
fileevent $s writable {set x 1}; vwait x
puts 3
puts $s [list TestExecute OK]
puts 4
if [info exists y] {unset y}
fileevent $s readable {set y 1}; vwait y
puts 5
gets $s line
puts 6
puts --$line--
}
if 0 {
global x y ;# for unix
puts 1
# set s [socket -async 150.163.2.175 80]
# set s [socket -async mtc-m13.sid.inpe.br 80]
# set s [socket -async mtc-m17.sid.inpe.br 80]
set s [socket -async micro02 19050]
# fconfigure $s -buffering line
puts 2
if [info exists x] {unset x}
# fileevent $s writable "set x 1" ;# works
fileevent $s writable {set x 1}
# fileevent $s writable set x 1 ;# doesn't work
# after 1000 "set x 0" ;# works
# after 1000 {set x 0} ;# works
after 1000 set x 0
vwait x
puts --$x--
}
if 0 {
proc ProcessWritableSocket {socket afterID} {
global x$socket
after cancel $afterID
set x$socket 1
}
set s [socket -async micro02 19050]
global x$s ;# for unix
if [info exists x$s] {unset x$s}
set afterID [after 100 set x$s 0]
# fileevent $s writable "set x$s 1"
fileevent $s writable "ProcessWritableSocket $s $afterID"
vwait x$s
puts --[set x$s]--
}
if 0 {
global apacheFlag ;# needed by after
set address mtc-m17.sid.inpe.br
set address banon-pc2
if [catch {socket -async $address 80} s] {
set apacheFlag 0
} else {
if [info exists apacheFlag] {unset apacheFlag}
fileevent $s writable {set apacheFlag 1}
set afterID [after 300 set apacheFlag 0]
vwait apacheFlag ;# wait at most 300 ms
after cancel $afterID
}
puts $apacheFlag
}
if 0 {
Load $homePath/@cmdbuf fileContent
puts $fileContent
}
if 0 {
set fileContent [Execute $serverAddressWithIP [list Load2 iconet.com.br/banon/2009/06.16.21.10 year=2009_adm.txt 33 source] 0]
puts --$fileContent--
set command [list list MultipleLinesLoad2 iconet.com.br/banon/2009/06.16.21.10 @relatorio.aux 33 doc]
set fileContent [join [MultipleExecute [list $serverAddressWithIP] $command] \n]
puts --$fileContent--
set fileContent [Execute $serverAddressWithIP [list Load2 urlib.net/www/2019/10.29.01.58 ROCdata/AUC_BBMM-DEFAULT_10_2016.txt 33 doc auto 1] 0]
puts --[join [lrange $fileContent end-2 end] \n]--
}
if 0 {
# testing Store2
set progress 10%
Execute $serverAddressWithIP [list Store2 $progress urlib.net/www/2012/12.25.00.38 progress.txt 33] 0
puts stored
}
if 0 {
set x [Execute $serverAddressWithIP [list UpdateArchivingPolicy dpi.inpe.br/banon-pc2@1905/2005/07.11.21.15 dpi.inpe.br/banon-pc2@1905/2005/07.11.21.15.43 banon 33] 0]
puts --$x--
}
if 0 {
global x2
proc Put {} {
puts OK
}
after 3000 Put
if [info exists x2] {unset x2}
set x2 0
after 1000 {set x2 1}; vwait x2
puts $x2
}
}
# TestExecute - end
# ----------------------------------------------------------------------