#
# Copyright for the Uniform Repository Service (c) 1995 - 2026
# by Gerald Banon. All rights reserved.
# Version 2.1
# resolve.tcl
#
# Created by GJFB on 2025-09-06 from an old version of from.tcl
#
# If the document is in the distributed collection defined by the local bibliographic mirror
# (unless the call is done from another mirror), it is returned,
# otherwise it is searched within the scope of the whole URLib collection
# ----------------------------------------------------------------------
# Resolve
# Examples of call through URL:
# these types of URL call the Resolve cgi script
if 0 {
http://mtc-m12.sid.inpe.br/urn:doi:10.17487/RFC8141?ibiurl.clientinformation.citingitem=urlib.net/www/2023/06.03.21.17&linktype=relative
http://urlib.net/urn:doi:10.17487/RFC8141?ibiurl.clientinformation.citingitem=urlib.net/www/2023/06.03.21.17&linktype=relative
http://gjfb0520.sid.inpe.br/urn:doi:10.1590/0001-3765202320210807?ibiurl.clientinformation.citingitem=urlib.net/www/2023/11.16.13.37&linktype=relative
http://gjfb:1905/urn:doi:10.1590/0001-3765202320210807?ibiurl.clientinformation.citingitem=urlib.net/www/2023/11.16.13.37&linktype=relative
http://gjfb:1905/doi:10.1590/0001-3765202320210807?ibiurl.clientinformation.citingitem=urlib.net/www/2023/11.16.13.37&linktype=relative
http://gjfb:1905/urn:doi:10.1590/0001-3765202320210807?ibiurl.clientinformation.citingitem=urlib.net/www/2023/11.16.13.37&linktype=relative
http://gjfb:1905/ibi/QABCDSTQQW/4E7MG35
http://gjfb:1905/ibi:QABCDSTQQW/4E7MG35
http://gjfb:1905/upn:9HFNHE:QABCDSTQQW/4E7MG35
http://gjfb:1905/upn:9HFNHE:QABCDSTQQW/4E7MG35?immediateupdateflag=1
http://gjfb:1905/ibi:8JMKD2USNRW34T/4EAN7CH
http://gjfb:1905/ibi/8JMKD2USNRW34T/4EAN7CH
http://gjfb:1905/ibi:QABCDSTQQW/4DS3BMS
http://gjfb:1905/ibi/QABCDSTQQW/4DS3BMS
http://gjfb:1905/urn:doi:10.1016/j.rse.2021.112667
http://gjfb:1905/ibi:dpi.inpe.br/banon/1998/08.02.08.56
http://gjfb:1905/ibi:dpi.inpe.br/banon/1998/08.02.08.56:+(en)
http://gjfb:1905/upn:9HFNHE:dpi.inpe.br/banon/1998/08.02.08.56:+(en)
http://gjfb:1905/dpi.inpe.br/banon/1998/08.02.08.56:+(en)
http://gjfb:1905/col/urlib.net/www/2015/10.21.00.46/doc/ibi:J8LNKB5R7W/3PGRQD8
http://gjfb:1905/col/urlib.net/www/2015/10.21.00.46/doc/upn:9HFNHE:J8LNKB5R7W/3PGRQD8
http://gjfb:1905/upn:9HFNHE:J8LNKB5R7W/3PGRQD8
http://mtc-m16d.sid.inpe.br/upn:35SP775:8JMKD3MGP7W/36U89RH
http://mtc-m21c.sid.inpe.br/upn:35SP775:8JMKD3MGP7W/36U89RH
http://gjfb:1905/upn:35SP775:8JMKD3MGP7W/36U89RH
http://gjfb0520.sid.inpe.br/col/urlib.net/www/2023/12.25.14.57/doc/upn:RFF2E5:8JMKD3MGPCW/3HHLNUH
http://gjfb0520.sid.inpe.br/col/urlib.net/www/2023/12.25.14.57/doc/upn:RFF2E5-:8JMKD3MGPCW/3HHLNUH
# with the query string linktype=relative, as below, the item search is extended to all sites (using urlib.net)
http://gjfb0520.sid.inpe.br/upn:EFDBHS:QABCDSTQQW/49884CP?linktype=relative
http://gjfb0520.sid.inpe.br/upn:EFDBHS:QABCDSTQQW/49884CP
http://gjfb0520.sid.inpe.br/upn:EFDBHS:QABCDSTQQW/49884CP?immediateupdateflag=1
http://gjfb0520.sid.inpe.br/upn:4F7Q9UH:bd/handle/bdcamara/41081?immediateupdateflag=1
http://gjfb:1905/upn:EFDBHS:QABCDSTQQW/49884CP
http://gjfb:1905/upn:EFDBHS:QABCDSTQQW/49884CP?linktype=relative
http://gjfb:1905/upn:EFDBHS:QABCDSTQQW/49884CP?immediateupdateflag=1
http://gjfb:1905/upn:EFDBHS:QABCDSTQQW/49884CP?immediateupdateflag=1&linktype=relative
http://gjfb:1905/upn:EFDBHS:QABCDSTQQW/49884CP?linktype=relative&immediateupdateflag=1
http://gjfb:1905/upn:EFDBHS:QABCDSTQQW/49884CP?linktype=relative&immediateupdateflag=1&xxx=yyy
http://gjfb:1905/upn:4F7Q9UH:bd/handle/bdcamara/41081
http://gjfb:1905/upn:4F7Q9UH:bd/handle/bdcamara/41081?immediateupdateflag=1
# in both URL below upn:4CR88AP no longer exists
# http://gjfb:1905/upn:4CR88AP:QABCDSTQQW/4BT93R5?ibiurl.clientinformation.citingitem=iconet.com.br/banon/2001/04.28.19.50&linktype=relative
# http://gjfb:1905/upn:4CR88AP-:QABCDSTQQW/4BT93R5?ibiurl.clientinformation.citingitem=iconet.com.br/banon/2001/04.28.19.50&linktype=relative
}
# Resolve is called by Apache or the cgi script From (see from.tcl) (
# redirectionFlag value is 0 or 1 (default); 1 means to execute a redirection and 0 to return
# when redirectionFlag is 0 the pathInfo must be fill out (the call is made in 'From')
# when redirectionFlag is 1 the pathInfo can be left empty (the call is made in Apache)
proc Resolve {{redirectionFlag 1} {pathInfo {}} {queryString {}}} {
# if [catch # ;# catch doesn't work. For some reason, catch impedes to return a non empty value to the cgi script Form (when redirectionFlag is 0) - the error message is: couldn't open "C:/ActiveTcl/lib/tclIndex": no such file or directory - the solution was to use global variable linkFromResolve
if [catch {
global env
global linkFromResolve ;# used in From - added by GJFB on 2025-12-02 because of the catched error: couldn't open "C:/ActiveTcl/lib/tclIndex": no such file or directory when executing http://gjfb:1905/col/iconet.com.br/banon/2008/12.11.01.03/doc/ibi:QABCDSTQQW/4E7MG35
global serverAddressWithIP ;# used in GetDestinationResolverURL
global trace ;# used in GetDestinationResolverURL
global immediateUpdateFlag
# OBS: destinationResolverID == namespacePrefix
# URI
# RFC 3986
# https://datatracker.ietf.org/doc/html/rfc3986
# Regular expression for breaking-down a well-formed URI reference into its components.
# ^(([^:/?#]+):)?(//([^/?#]*))?([^?#]*)(\?([^#]*))?(#(.*))?
# 12 3 4 5 6 7 8 9
# URN
# Regular Expressions Cookbook, 2nd Edition
# https://www.oreilly.com/library/view/regular-expressions-cookbook/9781449327453/ch08s06.htmlhttps://www.oreilly.com/library/view/regular-expressions-cookbook/9781449327453/ch08s06.html
# ^urn:[a-z0-9][a-z0-9-]{0,31}:[a-z0-9()+,\-.:=@;$_!*'%/?#]+$
# destinationResolverID
# regexp {^/(.+:.+):(.+)$} $env(PATH_INFO) m destinationResolverID destination ;# used with urn:doi only
# regexp {([^/]+):(.+)$} $env(PATH_INFO) m destinationResolverID destination ;# used with urn:doi and doi
# sourceResolver (localSite)
set sourceResolver $env(SERVER_NAME):$env(SERVER_PORT)
# homePath
set homePath $env(DOCUMENT_ROOT)
# URLibServiceRepository
set URLibServiceRepository $env(URLIB_SERVICE_REP)
# localSite
set localSite $env(SERVER_NAME):$env(SERVER_PORT)
# serverAddressWithIP
set serverAddressWithIP [list $env(IP_ADDR) $env(URLIB_PORT)]
# loCoInRep
set loCoInRep $env(LOCOINREP)
source $homePath/col/$URLibServiceRepository/doc/utilities1.tcl ;# StoreArray
source $homePath/col/$URLibServiceRepository/doc/cgi/mirrorfind-.tcl ;# ReturnCommunicationAddress
set trace 0
if $trace {
puts {Content-Type: text/html}
puts {}
puts "Resolve: redirectionFlag: --$redirectionFlag--
"
puts "Resolve: pathInfo: --$pathInfo--
"
puts "Resolve: queryString: --$queryString--
"
}
if $redirectionFlag {
# Resolve is called directly from Apache
set pathInfo $env(PATH_INFO)
if {[info exists env(QUERY_STRING)] && ![string equal {} $env(QUERY_STRING)]} {
# cgi
foreach {name value} [split $env(QUERY_STRING) &=] {
set cgi([DecodeURL $name]) [DecodeURL $value]
}
if $trace {puts "Resolve: cgi: --[array get cgi]--
"}
# when immediateupdateflag is 1, namespacePrefixXresolverURLarray, IBInamespacePrefixList and uriToResolverURLArray are updated on the fly, otherwise updating occurs on the next day
regsub {(\&?immediateupdateflag=[01]$|^immediateupdateflag=[01](\&?|$))} $env(QUERY_STRING) {} queryString
if ![string equal {} $queryString] {
set queryString ?$queryString
} else {
set queryString {}
}
} else {
set queryString {}
}
# immediateUpdateFlag
ConditionalSet immediateUpdateFlag cgi(immediateupdateflag) 0
} else {
# Resolve is called from From
# when immediateupdateflag is 1, namespacePrefixXresolverURLarray, IBInamespacePrefixList and uriToResolverURLArray are updated on the fly, otherwise updating occurs on the next day
if [regexp {immediateupdateflag=1} $queryString] {
set immediateUpdateFlag 1
regsub {(\&?immediateupdateflag=1$|^immediateupdateflag=1(\&?|$))} $queryString {} queryString
} else {
set immediateUpdateFlag 0
regsub {(\&?immediateupdateflag=0$|^immediateupdateflag=0(\&?|$))} $queryString {} queryString
}
}
if 0 {
puts {Content-Type: text/html}
puts {}
puts "pathInfo: $pathInfo
"
puts A-[regexp {.+:.+/} $pathInfo]
if [regexp {.+:.+/} $pathInfo] {
puts B-[regexp {([^/]+?:[^:]+):(.+$)} $pathInfo m destinationResolverID destination]
if ![regexp {([^/]+?:[^:]+):(.+$)} $pathInfo m destinationResolverID destination] { ;# used with urn:doi (urn:doi:xxx:yyy)
puts 1-$pathInfo
regexp {([^/]+):(.+$)} $pathInfo m destinationResolverID destination ;# used with doi (doi:10.1590/0001-3765202320210807)
} elseif {[regexp {[^:]+/} $destinationResolverID]} {
puts 2-$pathInfo
puts C-[regexp {([^/]+?):(.+$)} $pathInfo]
regexp {([^/]+?):(.+$)} $pathInfo m destinationResolverID destination
}
} else {
set destinationResolverID upn:[lindex [file split [ConvertFromRepository [lindex $loCoInRep 0] 1]] 1]-
set destination $pathInfo
}
# puts "=$destinationResolverID= $destination"
# http://gjfb:1905/dpi.inpe.br/banon/1998/08.02.08.56:+(en)
# A-0
# Location: http://gjfb:1905/IBI-:dpi.inpe.br/banon/1998/08.02.08.56:+(en)
# http://gjfb:1905/upn:9HFNHE:QABCDSTQQW/4E7MG35
# A-1
# B-1
# Location: http://gjfb:1905/IBI:QABCDSTQQW/4E7MG35
# http://gjfb:1905/ibi:dpi.inpe.br/banon/1998/08.02.08.56
# A-1
# B-0
# 1-ibi:dpi.inpe.br/banon/1998/08.02.08.56
# C-0
# Location: http://gjfb:1905/IBI:dpi.inpe.br/banon/1998/08.02.08.56
# http://gjfb:1905/ibi:dpi.inpe.br/banon/1998/08.02.08.56:+(en)
# A-1
# B-1
# 2-ibi:dpi.inpe.br/banon/1998/08.02.08.56:+(en)
# C-1
# Location: http://gjfb:1905/IBI:dpi.inpe.br/banon/1998/08.02.08.56:+(en)
# http://gjfb:1905/upn:9HFNHE:dpi.inpe.br/banon/1998/08.02.08.56:+(en)
# A-1
# B-1
# Location: http://gjfb:1905/IBI:dpi.inpe.br/banon/1998/08.02.08.56:+(en)
# http://gjfb:1905/ibi:dpi.inpe.br/banon/1998/08.02.08.56:?ibiurl.backgroundlanguage=en
# A-1
# B-0
# 1-ibi:dpi.inpe.br/banon/1998/08.02.08.56:
# Location: http://gjfb:1905/IBI:dpi.inpe.br/banon/1998/08.02.08.56:?ibiurl.backgroundlanguage=en
# http://gjfb:1905/col/urlib.net/www/2015/10.21.00.46/doc/upn:9HFNHE:J8LNKB5R7W/3PGRQD8
# A-1
# B-1
# Location: http://gjfb:1905/IBI:J8LNKB5R7W/3PGRQD8
}
if [regexp {.+:.+/} $pathInfo] {
if ![regexp {([^/]+?:[^:]+):(.+$)} $pathInfo m destinationResolverID destination] { ;# used with urn:doi (urn:doi:xxx:yyy)
regexp {([^/]+):(.+$)} $pathInfo m destinationResolverID destination ;# used with doi (doi:10.1590/0001-3765202320210807)
} elseif {[regexp {[^:]+/} $destinationResolverID]} {
regexp {([^/]+?):(.+$)} $pathInfo m destinationResolverID destination
}
} else {
set destinationResolverID upn:[lindex [file split [ConvertFromRepository [lindex $loCoInRep 0] 1]] 1]-
set destination $pathInfo
}
# staticIPFlag
set staticIPFlag [list [Execute $serverAddressWithIP [list ReturnStaticIPFlag] 0]]
if $trace {
puts {Content-Type: text/html}
puts {}
puts $pathInfo ;# => /urn:doi:10.17487/RFC8141
puts
puts $destinationResolverID ;# => urn:doi
puts
puts $destination ;# 10.17487/RFC8141
puts
puts --$queryString-- ;# => --?ibiurl.clientinformation.citingitem=urlib.net/www/2023/06.03.21.17--
puts
puts $staticIPFlag
puts $redirectionFlag
puts
}
if $trace {puts "Resolve: redirectionFlag: --$redirectionFlag--
"}
if $trace {puts "immediateUpdateFlag = $immediateUpdateFlag
"}
# Store xxx C:/tmp/bbb.txt auto 0 a
if ![info exists destinationResolverID] {
set url http://$sourceResolver/customizeerror.cgi/603
if $redirectionFlag {
puts "Location: $url"
puts ""
return
} else {
# return [regsub {https?://} $url {}]
set linkFromResolve [regsub {https?://} $url {}]
return
}
}
if [string equal {urn:ibi} $destinationResolverID] {
set url http://$sourceResolver/customizeerror.cgi/602
if $redirectionFlag {
puts "Location: $url"
puts ""
return
} else {
# return [regsub {https?://} $url {}]
set linkFromResolve [regsub {https?://} $url {}]
return
}
}
if 0 {
set url http://$localSite/ibi/$destination$queryString
puts "Location: $url"
puts ""
return
}
package require http
# IBInamespacePrefixList
set IBInamespacePrefixList [UpdateSourceIBInamespacePrefixList $destinationResolverID]
# thisDestinationResolverID
set thisDestinationResolverID upn:[lindex [file split [ConvertFromRepository [lindex $loCoInRep 0] 1]] 1]
# set thisDestinationResolverID upn:xxx ;# just for testing the performance difference
if 1 {
# Shorten the execution path
regsub -- {-$} $destinationResolverID {} destinationResolverID2
# puts ">>> $thisDestinationResolverID $destinationResolverID2"
if [string equal $thisDestinationResolverID $destinationResolverID2] {
# >>> the destination resolver is the current site
set repName [Execute $serverAddressWithIP [list FindRepositoryNameFromIBI $destination]] ;# added by GJFB on 2026-01-09
if [string equal {} $repName] {
# do nothing - doesn't work with http://gjfb:1905/upn:9HFNHE:QABCDSTQQW/4E7MG35 because QABCDSTQQW/4E7MG35 migrates to urlib.net
} else {
# the record is in the (local) collection
if {[lsearch -index 0 $IBInamespacePrefixList $destinationResolverID] != -1} {
# an IBI resolver
if [string equal {-} [string index $destinationResolverID end]] {
set url http://$localSite/IBI-:$destination$queryString
} else {
set url http://$localSite/IBI:$destination$queryString
}
} else {
# not an IBI resolver
set url http://$localSite/$destinationResolverID:$destination$queryString
}
if $redirectionFlag {
puts "Location: $url"
puts ""
return
} else {
# puts --$url--
# return [regsub {https?://} $url {}]
set linkFromResolve [regsub {https?://} $url {}]
return
}
}
}
# Shorten the execution path - end
}
# 2 namespacePrefixXresolverURLarray
if 0 {
# manual update of namespacePrefixXresolverURLarray
set namespacePrefixXresolverURLarray(upn:4CR88AP) $sourceResolver ;# added by GJFB on 2025-06-11
set namespacePrefixXresolverURLarray(upn:4CR88AP-) $sourceResolver ;# added by GJFB on 2025-06-11
set namespacePrefixXresolverURLarray(urn:doi) doi.org ;# added by GJFB on 2023-12-26
# set namespacePrefixXresolverURLarray(purl) purl.org
} else {
# automatic update of namespacePrefixXresolverURLarray
if [file exists $homePath/col/$URLibServiceRepository/auxdoc/namespacePrefixXresolverURLarray.tcl] {
source $homePath/col/$URLibServiceRepository/auxdoc/namespacePrefixXresolverURLarray.tcl ;# array set namespacePrefixXresolverURLarray cache
}
ConditionalSet outputValue namespacePrefixXresolverURLarray($destinationResolverID) {}
set startingTime 02:00:00
set startingSecond [clock scan $startingTime -base 109306800]
set seconds [clock seconds]
set timePeriod [expr 24*60*60] ;# 1 day
# similar code in ComputeFileUpdateFlag
# 1
set mtime [lindex $outputValue 1]
if [string equal {} $mtime] {set mtime 0}
if {$immediateUpdateFlag || [expr ($seconds - $startingSecond)/$timePeriod] != [expr ($mtime - $startingSecond)/$timePeriod]} {
# since the last update (mtime), at least one transition time has occured
# where the transition times is = {starting second + n * time period: n = 0, 1, ...}
# old array input value, the input value should be updated
# UPDATE namespacePrefixXresolverURLarray
# see: Returning the resolver URL of a given namespace prefix
# set url http://gjfb:1905/col/urlib.net/www/2025/09.08.04.08/doc/script.cgi?namespaceprefix=upn:4E9948J
# set url http://$sourceResolver/col/urlib.net/www/2025/09.08.04.08/doc/script.cgi?namespaceprefix=$destinationResolverID
set url http://urlib.net/col/urlib.net/www/2025/09.08.04.08/doc/script.cgi?namespaceprefix=$destinationResolverID
if [catch {http::geturl $url} token] {
# nothing to do
} else {
if {[http::ncode $token] == 200} {
set data [string trim [http::data $token]] ;# trim is a must
if [string equal {} $data] {
if [info exists namespacePrefixXresolverURLarray($destinationResolverID)] {unset namespacePrefixXresolverURLarray($destinationResolverID)}
} else {
set namespacePrefixXresolverURLarray($destinationResolverID) [list $data $seconds] ;# update namespacePrefixXresolverURLarray cache
}
StoreArray namespacePrefixXresolverURLarray $homePath/col/$URLibServiceRepository/auxdoc/namespacePrefixXresolverURLarray.tcl w list array 1
file delete $homePath/col/$URLibServiceRepository/auxdoc/uriPrefixXresolverURLarray.tcl ;# migration uriPrefixXresolverURLarray.tcl -> namespacePrefixXresolverURLarray.tcl - 2025-10-14
}
http::cleanup $token
}
# UPDATE namespacePrefixXresolverURLarray - end
} else {
# nothing to do
}
}
ConditionalSet outputValue namespacePrefixXresolverURLarray($destinationResolverID) {}
set resolverURLlist [lindex $outputValue 0]
if 0 {
puts
puts --$resolverURLlist--
}
if [string equal {} $resolverURLlist] {
# example: $destinationResolverID == IBI (IBI must not appear in a relative hyperlink)
if [regexp {^upn:} $destinationResolverID] {
set url http://$sourceResolver/customizeerror.cgi/604
} else {
set url http://$sourceResolver/customizeerror.cgi/603
}
puts "Location: $url"
puts ""
return
}
# 2 namespacePrefixXresolverURLarray - end
set url [GetDestinationResolverURL $sourceResolver $resolverURLlist $IBInamespacePrefixList $destinationResolverID $destination $queryString]
# puts --$url--
if [string equal {} $url] {
return "resolution of $destinationResolverID:$destination failed."
} else {
if 1 {
# Testing the URL using ibi, if the test fails, let try within the current static IP site
if {!$staticIPFlag && [regexp {ibi-?} $destinationResolverID]} {
if [catch {http::geturl $url} token] {
# nothing to do
} else {
if [regexp {200|302} [http::ncode $token]] { ;# 302 = an URL redirection occurs when resolving for example http://urlib.net/ibi:8JMKD3MGP3W34R/44C25PS (i.e. when using urlib.net as a source resolver)
set data [string trim [http::data $token]] ;# trim is a must
if [regexp {identifier warning} $data] {
# try this url:
set url http://$localSite/$thisDestinationResolverID:$destination$queryString
} else {
# url is OK
}
} else {
# try this url:
set url http://$localSite/$thisDestinationResolverID:$destination$queryString
}
http::cleanup $token
}
}
}
if $redirectionFlag {
puts "Location: $url"
puts ""
return
} else {
# puts OK
# return xxx
# return [regsub {https?://} $url {}]
set linkFromResolve [regsub {https?://} $url {}]
return
}
}
if 0 {
# old code
# if [regexp {^ibi-?$} $destinationResolverID] # ;# added by GJFB on 2023-11-11 to display a copy (if any) of the item identified by its doi - added by GJFB on 2025-06-29
if {0 && [regexp {^ibi-?$} $destinationResolverID]} { ;# added by GJFB on 2023-11-11 to display a copy (if any) of the item identified by its doi - added by GJFB on 2025-06-29
# set link $localSite/$destinationResolverID:$destination$queryString
set url http://$localSite/$destinationResolverID:$destination$queryString
} elseif {[regexp {^(urn:doi|doi)$} $destinationResolverID]} { ;# added by GJFB on 2023-11-11 to display a copy (if any) of the item identified by its doi - added by GJFB on 2025-06-29
# urn:doi or doi
# example: urn:doi:10.1590/0001-3765202320210807
global serverAddress ;# used by SetFieldValue
# source $homePath/col/$URLibServiceRepository/doc/utilities1.tcl
source $homePath/col/$URLibServiceRepository/doc/utilitiesMirror.tcl
source $homePath/col/$URLibServiceRepository/doc/cgi/mirrorfind-.tcl
# serverAddress
set serverAddress [list $env(SERVER_NAME) $env(URLIB_PORT)]
set resultList [FindMetadataRepositories "doi $destination" 0 {} {} no no 1]
if 0 {
puts {Content-Type: text/html}
puts {}
puts --$resultList--
}
if [string equal {} $resultList] {
# no copies of the item identified by its doi were found in the URLib collection
set url $resolverURL/$destination$queryString ;# use doi
} else {
# a copy was found
if [catch {http::geturl http://doi.org/} token] { ;# if added by GJFB on 2025-06-29
# site not found - use the copy
foreach {site rep-i} [lindex $resultList 0] {break}
# puts --$site--
# puts --${rep-i}--
SetFieldValue $site ${rep-i} identifier
# puts --$identifier--
# set link $namespacePrefixXresolverURLarray(upn:4CR88AP)/upn:4CR88AP:$identifier$queryString ;# use ibi copy
set url http://urlib.net/ibi:$identifier$queryString ;# use ibi copy
} else {
# use the original - added by GJFB on 2025-06-29
http::cleanup $token
set url $resolverURL/$destination$queryString ;# use doi
}
}
} else {
## upn:4CR88AP or upn:4CR88AP- or ibi or ibi- or ark or ...
# ark or ...
set url $resolverURL/$destinationResolverID:$destination$queryString
}
# location: http://doi.org/10.17487/RFC8141
if $redirectionFlag {
puts "Location: $url"
puts ""
return
} else {
# return [regsub {https?://} $url {}]
set linkFromResolve [regsub {https?://} $url {}]
return
}
# => Location: http://doi.org/10.1590/0001-3765202320210807?ibiurl.clientinformation.citingitem=urlib.net/www/2023/11.16.13.37&linktype=relative
}
} m] {
if ![string equal {} $m] {
puts {Content-Type: text/html}
puts {}
puts "Resolve: $m
"
if 0 {global errorInfo; puts $errorInfo
}
}
}
}
#
# Resolve - end
# ----------------------------------------------------------------------
# UpdateSourceIBInamespacePrefixList
# created by GJFB on 2025-11-20
# destinationResolverID is the namespace prefix of some Archive working as a destination resolver
# UpdateSourceIBInamespacePrefixList updates and returns IBInamespacePrefixList
# called by the cgi script Resolve only
if 0 {
set namespacePrefix upn:9HFNHE
UpdateSourceIBInamespacePrefixList $namespacePrefix
}
proc UpdateSourceIBInamespacePrefixList {destinationResolverID} {
# runs with post and cgi-script
global homePath
global URLibServiceRepository
global env
global immediateUpdateFlag
# package require http
set startingTime 02:00:00
set startingSecond [clock scan $startingTime -base 109306800]
set seconds [clock seconds]
set timePeriod [expr 24*60*60] ;# 1 day
if ![info exists homePath] {
set homePath $env(DOCUMENT_ROOT)
}
if ![info exists URLibServiceRepository] {
set URLibServiceRepository $env(URLIB_SERVICE_REP)
}
# automatic update of IBInamespacePrefixList
if [file exists $homePath/col/$URLibServiceRepository/auxdoc/IBInamespacePrefixList.tcl] {
source $homePath/col/$URLibServiceRepository/auxdoc/IBInamespacePrefixList.tcl ;# set IBInamespacePrefixList cache
} else {
set IBInamespacePrefixList {}
}
# similar code in ComputeFileUpdateFlag
# 2
set mtime [lindex [lsearch -index 0 -inline $IBInamespacePrefixList $destinationResolverID] 1]
if [string equal {} $mtime] {set mtime 0}
if {$immediateUpdateFlag || [expr ($seconds - $startingSecond)/$timePeriod] != [expr ($mtime - $startingSecond)/$timePeriod]} {
# since the last update (mtime), at least one transition time has occured
# where the transition times is = {starting second + n * time period: n = 0, 1, ...}
# old array input value, the input value should be updated
# UPDATE
# see: Confirming the existence of a given namespace prefix for the IBI namespace
# set url http://gjfb:1905/col/urlib.net/www/2025/09.20.21.06/doc/script.cgi?namespaceprefix=$destinationResolverID
set url http://urlib.net/col/urlib.net/www/2025/09.20.21.06/doc/script.cgi?namespaceprefix=$destinationResolverID
if [catch {http::geturl $url} token] {
# nothing to do
} else {
if {[http::ncode $token] == 200} {
set flag [http::data $token]
# puts --$flag--
if $flag {
lappend IBInamespacePrefixList [list $destinationResolverID $seconds]
set IBInamespacePrefixList [lsort -unique -index 0 $IBInamespacePrefixList]
} else {
set index [lsearch -index 0 $IBInamespacePrefixList $destinationResolverID]
set IBInamespacePrefixList [lreplace $IBInamespacePrefixList $index $index]
}
set fileContent "set IBInamespacePrefixList [list $IBInamespacePrefixList]"
Store fileContent $homePath/col/$URLibServiceRepository/auxdoc/IBInamespacePrefixList.tcl
file delete $homePath/col/$URLibServiceRepository/auxdoc/IBIuriPrefixList.tcl ;# migration IBIuriPrefixList.tcl -> IBInamespacePrefixList.tcl - 2025-10-14
}
http::cleanup $token
}
# UPDATE - end
} else {
# nothing to do
}
return $IBInamespacePrefixList
}
# UpdateSourceIBInamespacePrefixList - end
# ----------------------------------------------------------------------
# GetDestinationResolverURL
# called by the cgi script Resolve only
proc GetDestinationResolverURL {
sourceResolver resolverURLlist IBInamespacePrefixList destinationResolverID
destination queryString
} {
global trace
global immediateUpdateFlag
if 1 {
# scenario 1 - running the destination resolvers sequentially until the first one responds.
# experimentally faster - see example 2 in id QABCDSTQQW/4AEFPDB
# puts "scenario 1"
global serverAddressWithIP
if $trace {puts "serverAddressWithIP = $serverAddressWithIP
"}
if $trace {puts "resolverURLlist (1) = $resolverURLlist
"}
if $trace {puts "destinationResolverID = $destinationResolverID
"}
# Set the last successful resolver URL in the first position
set uri $destinationResolverID:$destination
if $trace {puts "uri = $uri
"}
# SUBMIT
# 3
foreach {lastSuccessfulResolverURL mtime} [Execute $serverAddressWithIP [list GetLastSuccessfulResolverURL $uri]] {break} ;# uses uriToResolverURLArray
if ![info exists lastSuccessfulResolverURL] {set lastSuccessfulResolverURL {}}
if $trace {puts "lastSuccessfulResolverURL = $lastSuccessfulResolverURL
"}
if ![info exists mtime] {set mtime 0}
if $trace {puts "mtime = --$mtime--
"}
if ![string equal {} $lastSuccessfulResolverURL] {
set index [lsearch $resolverURLlist $lastSuccessfulResolverURL]
set resolverURLlist [concat $lastSuccessfulResolverURL [lreplace $resolverURLlist $index $index]] ;# set the last successful resolver URL in the first position
}
# Set the last successful resolver URL in the first position - end
if $trace {puts "resolverURLlist (2) = $resolverURLlist
"}
set i 1
foreach resolverURL $resolverURLlist {
if $trace {puts "i = $i
"}
if [string equal {} $resolverURL] {
return http://$sourceResolver/customizeerror.cgi/603
}
if {[lsearch -index 0 $IBInamespacePrefixList $destinationResolverID] != -1} {
# an IBI resolver
if [string equal {-} [string index $destinationResolverID end]] {
set url $resolverURL/IBI-:$destination$queryString
} else {
set url $resolverURL/IBI:$destination$queryString
}
} else {
# not an IBI resolver
if [regexp {handle/} $destination] { ;# added by GJFB on 2026-02-21
# DSpace
set url $resolverURL/$destination$queryString
} else {
set url $resolverURL/$destinationResolverID:$destination$queryString
}
}
if {[llength $resolverURLlist] == $i} {
# just one resolver URL in resolverURLlist or the resolver URL is the last in resolverURLlist
# Update uriToResolverURLArray
if ![regexp $resolverURL $lastSuccessfulResolverURL] {
# SUBMIT
if $trace {puts "Call to UpdateURItoResolverURLArray $uri $resolverURL (1)
"}
set message [Execute $serverAddressWithIP [list UpdateURItoResolverURLArray $uri $resolverURL]]
}
# Update uriToResolverURLArray - end
if $trace {puts "url 1 = $url
"}
return $url ;# untested URL - may produce an identifier warning which can eventually be avoid next day after the right change of the reference namespacePrefixXresolverURLarray
} else {
# more than one resolver URL in resolverURLlist and the resolver URL is NOT the last in resolverURLlist
if {$i == 1} {
# more than one resolver URL in resolverURLlist and the resolver URL is the FIRST resolver URL in resolverURLlist
set startingTime 02:00:00
set startingSecond [clock scan $startingTime -base 109306800]
set seconds [clock seconds]
set timePeriod [expr 24*60*60] ;# 1 day
# similar code in ComputeFileUpdateFlag
if [string equal {} $mtime] {set mtime 0}
if $trace {puts "mtime = $mtime
"}
if $trace {puts "immediateUpdateFlag = $immediateUpdateFlag
"}
if {$immediateUpdateFlag || [expr ($seconds - $startingSecond)/$timePeriod] != [expr ($mtime - $startingSecond)/$timePeriod]} {
# since the last update (mtime), at least one transition time has occured
# where the transition times is = {starting second + n * time period: n = 0, 1, ...}
# old array input value, the input value should be updated
# the first click of the day
# testing the item URL
set testingFlag 1
} else {
set testingFlag 0
## set testingFlag 1 ;# used to force testing the item URL - useful to correct wrong uriToResolverURLArray (in the RAM) and consequently lastSuccessfulResolverURL without doing unpost/post - now done with setting immediateUpdateFlag to 1
}
if $trace {puts "testingFlag (1) = $testingFlag
"}
} else {
# testing the item URL
set testingFlag 1
if $trace {puts "testingFlag (2) = $testingFlag
"}
}
if $testingFlag {
if $trace {puts "testing $url
"}
# testing the item URL
if [catch {http::geturl $url} token] {
# nothing to do
} else {
if $trace {puts "ncode = [http::ncode $token]
"}
# if {[http::ncode $token] == 200} #
if [regexp {200|302} [http::ncode $token]] { ;# 302 = an URL redirection occurs when resolving for example http://urlib.net/ibi:8JMKD3MGP3W34R/44C25PS (i.e. when using urlib.net (or any IBI resolver) as a source resolver)
set data [string trim [http::data $token]] ;# trim is a must
if [regexp {identifier warning} $data] {
http::cleanup $token
if $trace {puts "continue
"}
incr i
continue
} else {
http::cleanup $token
# Update uriToResolverURLArray
# if ![regexp $resolverURL $lastSuccessfulResolverURL] #
# SUBMIT
if $trace {puts "Call to UpdateURItoResolverURLArray $uri $resolverURL (2)
"}
set message [Execute $serverAddressWithIP [list UpdateURItoResolverURLArray $uri $resolverURL]]
# #
# Update uriToResolverURLArray - end
if $trace {puts "url 2 = $url
"}
return $url
}
}
http::cleanup $token
}
} else {
# NO testing of the item URL is needed (assuming that no migration occurred since the first click of the day)
if $trace {puts "url 3 = $url
"}
return $url
}
}
incr i
}
set url {}
return $url
} else {
# scenario 2 - running all the destination resolvers simultaneously until the first one responds.
foreach resolverURL $resolverURLlist {
if {[lsearch -index 0 $IBInamespacePrefixList $destinationResolverID] != -1} {
# an IBI resolver
if [string equal {-} [string index $destinationResolverID end]] {
set url $resolverURL/IBI-:$destination$queryString
} else {
set url $resolverURL/IBI:$destination$queryString
}
} else {
# not an IBI resolver
set url $resolverURL/$destinationResolverID:$destination$queryString
}
if {[llength $resolverURLlist] == 1} {
if $trace {puts "url 4 = $url
"}
return $url
} else {
if [catch {http::geturl $url} token] {
# nothing to do
} else {
set urlArray($token) $url
}
}
}
set time 0 ;# ms
set delay 200 ;# ms - one must have at least one site running before 200 ms, otherwise close all sockets
while {$time < $delay} {
set xWaitQueue 0; after 20 {set xWaitQueue 1}; vwait xWaitQueue
foreach token [array names urlArray] {
if [string equal {ok} [http::status $token]] {
# if {[http::ncode $token] == 200} #
# puts [http::ncode $token]
if [regexp {200|302} [http::ncode $token]] { ;# 302 = an URL redirection occurs when resolving for example http://urlib.net/ibi:8JMKD3MGP3W34R/44C25PS (i.e. when using urlib.net as a source resolver)
set data [string trim [http::data $token]] ;# trim is a must
if [regexp {identifier warning} $data] {
http::cleanup $token
# set url $urlArray($token)
unset urlArray($token)
continue
} else {
set url $urlArray($token)
http::cleanup $token
if $trace {puts "url 5 = $url
"}
return $url
}
}
# http::cleanup $token
}
http::cleanup $token
}
incr time 20 ;# ms
}
if [info exists url] {
if $trace {puts "url 6 = $url
"}
return $url
} else {
return
}
}
}
# GetDestinationResolverURL - end
# ----------------------------------------------------------------------