# Copyright for the Uniform Repository Service (c) 1995 - 2022, 2026
# by Gerald Banon. All rights reserved.
# Version 2.1
# get-.tcl
# If file is present then the file is shown instead of the target file
# (if any).
# Examples:
# rep-/dpi.inpe.br/banon/1998/08.02.08.56
# PATH_INFO = /dpi.inpe.br/banon/1998/08.02.08.56
# rep-/dpi.inpe.br/banon/1998/08.02.08.56/file
# PATH_INFO = /dpi.inpe.br/banon/1998/08.02.08.56/file
# http://banon-pc3/dpi.inpe.br/banon-pc3/2010/11.22.15.56??languagebutton=en
# is equivalent to:
# http://banon-pc3/dpi.inpe.br/banon-pc3/2010/11.22.15.56.39?languagebutton=en
# Examples:
if 0 {
http://gjfb:1905/J8LNKB5R7W/3L466J5:
http://gjfb:1905/J8LNKB5R7W/3L466J5:(oai_dc)
http://gjfb:1905/LK47B6W/362SFKH
http://gjfb:1905/LK47B6W/362SFKH:
http://banon-pc3/iconet.com.br/banon/2009/09.09.22.01
http://gjfb:1905/J8LNKB5R7W/3NGUDHH
http://gjfb:1905/zip/J8LNKB5R7W/3NGUDHH
http://vaio:1905/J8LNKB5R7W/3NGUDHH:
http://gjfb.home:1905/J8LNKB5R7W/3NGUDHH
http://gjfb.home:1905/8JMKD3MGP3W34P/3MPQ9AE
http://gjfb.home:1905/8JMKD3MGP3W34P/3MPQ9AE?ibiurl.returntype=urlpropertylist
http://urlib.net/8JMKD3MGPAW34P/3NERTH2
http://urlib.net/J8LNKB5R7W/3CAK5T2
http://urlib.net/8JMKD3MGPAW/3MGQ5S5
http://urlib.net/J8LNKB5R7W/3CP2248
}
# ----------------------------------------------------------------------
# Get-
proc Get- {} {
if [catch {
global env ;# used by ResolveIBI
global cgi ;# used by FindLanguage and ResolveIBI
global localSite ;# used by CheckCommunication, CreateResponseList and GetServerAddressFromHTTPHost
global homePath ;# used by CreateListOfurlPropertiesFromAgencies, ResolveIBI and FindLanguage
global URLibServiceRepository
global loCoInRep ;# used in CreateListOfurlPropertiesFromAgencies and FormatSiteList called by FindURLPropertyList called by ReturnURLPropertyList called by ReturnURLPropertyList2 called by ResolveIBI
global loBiMiRep ;# used in FindURLPropertyList called by ResolveIBI
global serverAddress ;# used by SetFieldValue and GetServerAddressFromHTTPHost
# global documentServerAddress ;# used by UpdateReadPermissionFromSecondaryDate
global mirrorHomePageRep ;# set by FindLanguage
global queueLengthFlag ;# used in MultipleSubmit (called in MultipleExecute2 called in CreateOutput)
global printFlag ;# used in ReturnURLPropertyList only
global selectedLanguageFromMirror languageRep1 languageRep2 ;# used in CreateResponseList only
global serverAdministratorAddress ;# used in FindURLPropertyList
set printFlag 0
# set printFlag 1
if $printFlag {
puts {Content-Type: text/html}
puts {}
}
set printFlag 0
# set printFlag 1
set col ../../../../..
set URLibServiceRepository $env(URLIB_SERVICE_REP)
source ../$col/$URLibServiceRepository/doc/utilities1.tcl
source ../$col/$URLibServiceRepository/doc/cgi/mirrorfind-.tcl
source ../$col/$URLibServiceRepository/doc/cgi/get.tcl ;# added by GJFB on 2022-07-12 - get.tcl contains ReturnRestrictedAccessWarning
# set queueLengthFlag 1 ;# could be anything - added by GJFB on 2013-04-17 in order to detect not writable site (site that doesn't reply)
# e.g., http://gjfb.home/dpi.inpe.br/banon-pc2@80/2008/11.25.15.05/pasta/manuscrito VERSÃO 2.pdf
# => /dpi.inpe.br/banon-pc2@80/2008/11.25.15.05/pasta/manuscrito VERSÃO 2.pdf
# puts [ConvertURLToHexadecimal $env(PATH_INFO) 1]
# => /dpi.inpe.br/banon-pc2@80/2008/11.25.15.05/pasta/manuscrito%20VERS%c3%92O%202.pdf
# encoding system utf-8 ;# added by GJFB on 2015-01-09 to solve the accent problem with gjfb.home (Windows OS) when the filePath contains upper case accented letter (e.g., Ã)
# ;# commented by GJFB on 2015-02-04 to solve the accent problem with mtc-m20.sid.inpe.br - utf-8 caracters appear in the language warning , ex: http://urlib.net/8JMKD3MGP7W/3D6463P+(fr)
# ;# the same command line placed below (just before ParseIBIURL) seems to solve this accent problem!
# puts $env(PATH_INFO)
# => /dpi.inpe.br/banon-pc2@80/2008/11.25.15.05/pasta/manuscrito VERSÃO 2.pdf
# puts [ConvertURLToHexadecimal $env(PATH_INFO) 1]
# => /dpi.inpe.br/banon-pc2@80/2008/11.25.15.05/pasta/manuscrito%20VERS%c3%83O%202.pdf
# loCoInRep
set loCoInRep $env(LOCOINREP)
# loBiMiRep
set loBiMiRep $env(LOBIMIREP)
# mirror
set mirror $loBiMiRep
# homePath
set homePath $env(DOCUMENT_ROOT)
# localSite
set localSite $env(SERVER_NAME):$env(SERVER_PORT)
# serverAddress
set serverAddress [list $env(SERVER_NAME) $env(URLIB_PORT)]
# serverAddressWithIP
set serverAddressWithIP [list $env(IP_ADDR) $env(URLIB_PORT)]
# urlibServerAddress
set urlibServerAddress $env(URLIB_SERVER_ADDR) ;# www.urlib.net and port
# serverAdministratorAddress
set serverAdministratorAddress $env(SERVER_ADMIN)
# Check if the collection has been posted - CheckCommunication calls StoreIndex which set loBiMiRep (globally)
if [CheckCommunication] {return} ;# needs localSite - Apache runs but URLib not
# Check if the collection has been posted - end
# cgi - used in FindLanguage
if [info exists env(QUERY_STRING)] {
# ? is alias for verb=GetMetadata
## ?+ is alias for verb=GetAppropriateMetadata
regsub {^\?} $env(QUERY_STRING) {} queryString2
foreach {name value} [split $queryString2 &=] {
set cgi([DecodeURL $name]) [DecodeURL $value]
}
}
# queryString
ConditionalSet queryString env(QUERY_STRING) {}
# set xxx $queryString
# Store xxx C:/tmp/bbb.txt binary 0 a
# puts $queryString
# => ibiurl.returntype=urlpropertylist
# if ![info exists cgi(mirror)] {set cgi(mirror) $loBiMiRep}
# if ![info exists cgi(languagebutton)] {set cgi(languagebutton) {}}
# puts [array get cgi]
# Find the language and the language repository
# use the same languages as the ones used for the local bibliographic mirror
foreach {selectedLanguageFromMirror languageRep1 languageRep2 firstLanguageRep submissionFormRep} [FindLanguage $mirror] {break}
# selectedLanguageFromMirror is argument for ResolveIBI
# Find the language and the language repository - end
# puts $selectedLanguageFromMirror
# set encodingSystem [encoding system]
encoding system utf-8 ;# added by GJFB on 2015-01-09 to solve the accent problem with gjfb.home (Windows OS) when the filePath contains upper case accented letter (e.g., Ã) - must be just before recreating pathInfo
if [info exists env(PATH_INFO)] {
set pathInfo $env(PATH_INFO)
} else {
set pathInfo /
}
# set encodingSystem $encodingSystem
# puts $pathInfo
# puts [ConvertURLToHexadecimal $pathInfo 1]
if [catch {ParseIBIURL $pathInfo $queryString} parsedIBIURL] {
# syntax error
# example: http://banon-pc3.dpi.inpe.br/rep/LK47B6/362SFKI
# puts $parsedIBIURL
# => syntax error 2
# global errorInfo
# puts $errorInfo
source ../$col/$languageRep2/doc/mirror/${selectedLanguageFromMirror}Cover.tcl
catch {subst [set [list ${languageRep2}::syntax error]]} output
error $output
}
# ibiURLArray
array set ibiURLArray $parsedIBIURL
if 1 {
# added by GJFB on 2022-07-12 to allow the possible display of Warning1 and Warning2
set fieldNameList2 [concat $ibiURLArray(parsedibiurl.metadatafieldnamelist) {title readpermission mirrorrepository readergroup}]
set ibiURLArray(parsedibiurl.metadatafieldnamelist) [lsort -unique $fieldNameList2]
set parsedIBIURL [array get ibiURLArray]
}
# Create urlPropertyList2
# set agencyStructureFlag 0 ;# disable agency structure
set agencyStructureFlag 1 ;# enable agency structure
set condition [expr $agencyStructureFlag && ([string equal $serverAddress $urlibServerAddress] || [string equal www.$serverAddress $urlibServerAddress]) && [string equal {} $queryString] && ![regexp {[\w/@.]+[!+:]} $pathInfo]]
# >>> for testing
# set condition [expr $agencyStructureFlag && [string equal {} $queryString]] ;# for testing
# set condition [expr $agencyStructureFlag && [file exists $homePath/col/$loCoInRep/auxdoc/agencyHTTPHostList.tcl] && [string equal {} $queryString]] ;# for future use - for more than two resolver layers
if 0 {
puts {Content-Type: text/html}
puts {}
puts "condition = $condition"
puts "parsedIBIURL = $parsedIBIURL"
puts "selectedLanguageFromMirror = $selectedLanguageFromMirror"
puts "languageRep1 = $languageRep1"
puts "languageRep2 = $languageRep2"
puts "localSite = $localSite"
}
if $condition {
# try using the agency structure
# agency structure specific code
# www.urlib.net resolver running
set urlPropertyList2 [CreateListOfurlPropertiesFromAgencies $parsedIBIURL $selectedLanguageFromMirror $languageRep1 $languageRep2 $localSite]
# set xxx 2-$urlPropertyList2
# Store xxx C:/tmp/bbb.txt binary 0 a
set agencyStructureFlag2 1 ;# agency structure used
} else {
set agencyStructureFlag2 0 ;# agency structure not used
}
if {!$agencyStructureFlag2 || ([info exists urlPropertyList2] && [string equal {} $urlPropertyList2])} {
# agency structure disabled or not used or fails to connect to all agencies and to find the url properties of the ibi
# not agency structure specific code
# any resolvers (www.urlib.net or agency resolvers) running
# agency resolver running
# >>> step 1 (output) of the agency structure communication scheme (www.urlib.net resolver -> agency resolver)
# http://gjfb.home:1905/rep-/J8LNKB5R7W/3N8UTK5?ibiurl.returntype=urlpropertylist
# http://gjfb.home:1905/rep-/urlib.net/www/2013/06.24.20.00?ibiurl.returntype=urlpropertylist
## ibiURLArray
# array set ibiURLArray $parsedIBIURL
# puts >>>$parsedIBIURL
# puts --[array get cgi]--
# set displayWarningMessage 1 ;# commented by GJFB on 2017-02-20
set displayWarningMessage [string equal {content} $ibiURLArray(parsedibiurl.returntype)] ;# added by GJFB on 2017-02-20 - agency structure communication
# set countOneClickFlag 1 ;# commented by GJFB on 2017-03-18
# set trueIBIFlag 0 ;# commented by GJFB on 2017-03-18
## set trueIBIFlag 1 ;# for testing
# RESOLVEIBI
# www.urlib.net resolver running (displayWarningMessage is 1)
# agency resolver running (displayWarningMessage is 0)
# set urlPropertyList2 [ResolveIBI $parsedIBIURL $selectedLanguageFromMirror $displayWarningMessage] ;# commented by GJFB on 2017-02-20
set urlPropertyList2 [ResolveIBI $parsedIBIURL $selectedLanguageFromMirror $displayWarningMessage {} 0 $agencyStructureFlag] ;# added by GJFB on 2017-02-20
# puts --$urlPropertyList2--
# set xxx 1-$urlPropertyList2
# Store xxx C:/tmp/bbb.txt binary 0 a
if [string equal {} $urlPropertyList2] { ;# added by GJFB on 2017-02-20 - agency structure communication
# ibi not found
# agency resolver (displayWarningMessage is 0 and ResolveIBI doesn't execute the error command)
# puts {Content-Type: text/plain}
# puts {}
# puts {warningmessage {ibi not found}}
return ;# must return empty because of the if within CreateListOfurlProperties)
exit ;# produces an Internal Server Error
}
}
# Create urlPropertyList2 - end
if {[info exists printFlag] && $printFlag} {
set list {}
foreach {name value} $urlPropertyList2 {
lappend list [list $name $value]
}
puts "Get-: output of ResolveIBI
"
puts [join $list
]
puts
}
array set urlPropertyArray $urlPropertyList2
# puts $urlPropertyArray(url)
# site (document site)
set site $urlPropertyArray(archiveaddress)
# documentServerAddress
set documentServerAddress [GetServerAddressFromHTTPHost $site] ;# added by GJFB on 2022-07-12
# puts [info exists urlPropertyArray(metadatafieldlist)]
ConditionalSet metadataFieldList urlPropertyArray(metadatafieldlist) {}
# puts --$metadataFieldList--
# => --mirrorrepository dpi.inpe.br/banon/1999/06.19.17.00 readergroup {} readpermission {deny from all and allow from 150.163} title {Les tableaux de corrélation dont les marges sont données}--
foreach {metadataFieldName metadataFieldValue} $metadataFieldList {
set $metadataFieldName $metadataFieldValue ;# set title, readpermission, mirrorrepository and readergroup
}
# puts $urlPropertyArray(contenttype)
# => Metadata
if {0 || [info exists readpermission] && [regexp {deny} $readpermission] && [string equal {Metadata} $urlPropertyArray(contenttype)]} {
# added by GJFB on 2022-07-12 to allow the possible display of Warning1 and Warning2
# similar code in Get
if ![string equal $site [regsub {:80$} $localSite {}]] {
# REDIRECT
puts "Location: http://$site$env(REQUEST_URI)" ;# ex: Location: http://gjfb:1905/ibi/Warning2?title=Les tableaux de corrélation dont les marges sont données
return
}
# url
set url $urlPropertyArray(url)
set convertedURL $url ;# url is already converted in CreateAbsolutePath
regsub {http://} $convertedURL {} srcBody
if 0 {
ConditionalSet metadataFieldList urlPropertyArray(metadatafieldlist) {}
foreach {metadataFieldName metadataFieldValue} $metadataFieldList {
set $metadataFieldName $metadataFieldValue ;# set title, readpermission, mirrorrepository and readergroup
}
}
# if ![regexp {:} $pathInfo] # ;# added by GJFB on 2021-11-28 otherwise metadata of restricted access information item are not displayed - commented by GJFB on 2022-09-07
if {![regexp {:} $pathInfo] && [string equal {Data} $urlPropertyArray(contenttype)]} { ;# added by GJFB on 2021-11-28 otherwise metadata of restricted access information item are not displayed - added by GJFB on 2022-09-07 to bypass the warning messages when the ibi is the metadata repository of restricted access item
# not metadata
# puts "$readpermission --$readergroup-- $mirrorrepository $documentServerAddress $site"
# puts [ReturnRestrictedAccessWarning $mirrorrepository $documentServerAddress $site]
set noAccessRestrictionFlag [ComputeAccessRestrictionFlag $readpermission $env(REMOTE_ADDR)]
# puts $noAccessRestrictionFlag
if [regexp {allow} $readpermission] {
if !$noAccessRestrictionFlag {
# access restriction
if [ReturnRestrictedAccessWarning $mirrorrepository $documentServerAddress $site] {
if [string equal {} $readergroup] {
# 2. readp allow and readp deny and not readerg * (search expression)
# Warning2
puts "Location: http://$localSite/ibi/Warning2?title=$title"
return
} else {
# 3. readp allow and readp deny and readerg * (search expression)
# Warning1
puts "Location: http://$localSite/ibi/Warning1?title=$title&srcbody=$srcBody"
return
}
}
}
} else {
# 4. not readp allow and readp deny and readerg * (search expression)
if {[regexp {deny} $readpermission] && ![string equal {} $readergroup]} {
if [ReturnRestrictedAccessWarning $mirrorrepository $documentServerAddress $site] {
# Warning1
puts "Location: http://$localSite/rep/Warning1?title=$title&srcbody=$srcBody"
return
}
}
}
}
} else {
# url
set url $urlPropertyArray(url)
}
## file
# set file $ibiURLArray(parsedibiurl.filepath) ;# used to decide to count one click only - commented by GJFB on 2017-02-25 - file variable not used
if 0 {
puts {Content-Type: text/plain}
puts {}
puts --$url--
puts $urlPropertyList2
exit
}
if 0 { ;# commented by GJFB on 2017-02-23 - pathInfo2 not used
# pathInfo2
regsub {http://} $url {} link
regexp {[^?]*} $link pathInfo2 ;# drop query string - otherwise URParts would contain ? and EnterQueue (called in WaitQueue called in CountOneClick) would return always 1
set pathInfo2 [file split $pathInfo2]
}
if {![info exists ibiURLArray(parsedibiurl.returntype)] || [string equal {content} $ibiURLArray(parsedibiurl.returntype)]} { ;# added by GJFB on 2017-02-20
# no returntype (agency structure specific code) or returntype == content
# not agency strucure specific code
# any resolvers (www.urlib.net or agency resolvers) running
# urlPropertyList3
set clientIPAddress [GetClientIP]
lappend urlPropertyList3 clientinformation.ipaddress $clientIPAddress
lappend urlPropertyList3 contenttype $urlPropertyArray(contenttype)
if [info exists urlPropertyArray(ibi)] {lappend urlPropertyList3 ibi $urlPropertyArray(ibi)} ;# urlPropertyArray(ibi) always exists with the URLib platform but may not exist with others, for example when the URL points to metadata
lappend urlPropertyList3 servicesubject acknowledgment
lappend urlPropertyList3 state $urlPropertyArray(state)
# if [info exists urlPropertyArray(url)] {lappend urlPropertyList3 url $urlPropertyArray(url)}
lappend urlPropertyList3 url $urlPropertyArray(url)
lappend urlPropertyList3 url.persistent http://$localSite$env(REQUEST_URI) ;# add persistent URL
# if [info exists urlPropertyArray(urlkey)] {lappend urlPropertyList3 urlkey $urlPropertyArray(urlkey)}
lappend urlPropertyList3 urlkey $urlPropertyArray(urlkey)
ConditionalSet citingItem cgi(ibiurl.clientinformation.citingitem) {} ;# added by GJFB on 2026-01-12
lappend urlPropertyList3 clientinformation.citingitem $citingItem ;# added by GJFB on 2026-01-12
if {[info exists printFlag] && $printFlag} {
set list {}
foreach {name value} $urlPropertyList3 {
lappend list [list $name $value]
}
puts "Get-: query string for acknowledgment
"
puts [join $list
]
puts
}
if 0 {
AcknowledgeArchive $urlPropertyList2 ;# Count one click
} else {
package require http
# servicesubject=acknowledgment
# step 5 (input) of the norm communication scheme (resolver -> Archive)
set queryString [ConvertListForArratyToQueryString $urlPropertyList3]
# set documentServerAddress $urlPropertyArray(archiveaddress) ;# commented by GJFB on 2022-07-12 - now above
set documentArchiveAddress $urlPropertyArray(archiveaddress) ;# added by GJFB on 2026-01-12
set index [lindex $urlPropertyArray(ibi.archiveservice) end]
if {[info exists printFlag] && $printFlag} {
puts http://$documentServerAddress/$index?$queryString
puts
}
## J8LNKB5R7W/3FTRH3S == Archive service for IBI resolution
# if [catch {http::geturl [ConvertURLToHexadecimal http://$documentServerAddress/J8LNKB5R7W/3FTRH3S?$queryString 1]} token] #
## puts [ConvertURLToHexadecimal http://$documentServerAddress/$index?$queryString 1]
# if [catch {http::geturl [ConvertURLToHexadecimal http://$documentServerAddress/$index?$queryString 1] -timeout 2000} token] # ;# commented by GJFB on 2026-01-12
# puts [ConvertURLToHexadecimal http://$documentServerAddress/$index?$queryString 1]
if [catch {http::geturl [ConvertURLToHexadecimal http://$documentArchiveAddress/$index?$queryString 1] -timeout 4000} token] { ;# added by GJFB on 2026-01-12 - 4000 required on Windows
} else {
# geturl returned
if [string equal {404} [::http::ncode $token]] {
# not found
# puts {not found}
} else {
# puts OK
# puts --[string trimright [http::data $token]]--
}
http::cleanup $token
}
}
# convertedURL
if 0 {
# doesn't work when opening sid.inpe.br/mtc-m15@80/2006/12.06.11.48 (located at mtc-m15)
# set encodingName [Execute $documentServerAddress [list GetEncodingName]]
# set encodingName utf-8
# set convertToUTF8 [regexp {Apache/2} $env(SERVER_SOFTWARE)]
# set convertToUTF8 [expr [regexp {Apache/2} $env(SERVER_SOFTWARE)] || [string equal {utf-8} $env(ENCODING_SYSTEM)]] ;# solves the accent problem - same code is used in xxDocContent.html
# set convertToUTF8 [expr [regexp {Apache/2} $env(SERVER_SOFTWARE)] || [string equal {utf-8} $encodingName]] ;# solves the accent problem - same code is used in xxDocContent.html
# set link [ConvertURLToHexadecimal $link $convertToUTF8]
# set link [ConvertURLToHexadecimal $link 1] ;# solves the accent problem - communication from banon-pc3 to plutao
# set convertedURL [ConvertURLToHexadecimal http://$link 1] ;# solves the accent problem - communication from banon-pc3 to plutao
set convertedURL [ConvertURLToHexadecimal $url 1] ;# solves the accent problem - communication from banon-pc3 to plutao
} else {
# returning to old code - done by GJFB on 2010-10-26
# works with http://banon-pc3/rep/dpi.inpe.br/plutao@80/2009/07.13.14.44
# works when opening sid.inpe.br/mtc-m15@80/2006/12.06.11.48 (located at mtc-m15)
if 0 {
# commented by GJFB on 2014-12-30 - conversion is now made in CreateAbsolutePath - encodingsystem is obsolete
set encodingName $urlPropertyArray(encodingsystem)
set convertToUTF8 [string equal {utf-8} $encodingName] ;# solves the accent problem - same code is used in xxDocContent.html
}
if 0 {
if [regsub {^http://[^/]+/(col/[^/]+/[^/]+/[^/]+/[^/]+/doc/[^?]*)} $url "$homePath/\\1" filePath] {
# filePath is used instead of the target file path because they might not be coded in the same way
# commented by GJFB on 2014-12-30 - the url is now utf-8 coded in GetURLPropertyList - encodingsystem is obsolete
set convertToUTF8 [expr [string equal {utf-8} $encodingName] && ![file exists $filePath]] ;# solves the accent problem when image file names are coded differently (iso and utf) in the same directory (in consequence of a migration between different operating systems (iso and utf)) - added by GJFB on 2013-09-01 - with the new operating system of md-m09.sid.inpe.br, inputList was created (in UpdateRepMetadataRep) with utf-8 as given by $env(ENCODING_SYSTEM) and the current encoding system is iso8859-1 (because of the apache configuration: AddDefaultCharset ISO-8859-1
}
}
if 0 {
# commented by GJFB on 2014-12-30 - conversion is now made in CreateAbsolutePath - encodingsystem is obsolete
set convertedURL [ConvertURLToHexadecimal $url $convertToUTF8] ;# solves the accent problem - communication from banon-pc3 to plutao
} else {
# set convertedURL $url ;# url is already converted in CreateAbsolutePath
regsub -all { } $url {+} convertedURL ;# added by GJFB on 2015-02-11 to avoid:
# Get- (2): Illegal characters in URL path - the URL was 'http://bibdigital.sid.inpe.br/col/sid.inpe.br/bibdigital@80/2006/11.11.23.17/doc/mirror.cgi?x=14&cssfileurl=http://www.dsr.inpe.br/sbsr2005/tmp/include/estilo_bib.css&y=11&continue=yes&query=roberta de cassia&dontdisplaysearchresultwarning=x&choice=briefTitleAuthorMisc'
# when entering "roberta de cassia" in the search field at: http://www.inpe.br/biblioteca/
# http::geturl doesn't accept blank space
set convertedURL [ConvertURLToHexadecimal $convertedURL] ;# added by GJFB on 2017-07-18 to avoid:
# Get- (2): Illegal characters in URL path - when the URL contains a query with | as in y 1983|* (CreateAbsolutePath doesn't process the query part)
}
}
if $env(ERROR_TRACE) {
global pid ;# set in MakeCgiScript
global clicks ;# set in MakeCgiScript
file delete "$homePath/@cgiLog$clicks-$pid" ;# delete doesn't work after puts "Location: "
}
if 1 {
# testing accessibility
package require http
if [catch {http::geturl $convertedURL -timeout 100} token] {
puts {Content-Type: text/html}
puts {}
puts "Get- (2): $token - the URL was '$convertedURL'"
exit
}
set code [http::code $token] ;# 302 Found; 400 Bad Request; 401 Authorization Required; 403 Forbidden; 404 Not Found
http::cleanup $token
if ![regexp {200|302|400|401|403|^$} $code] {
puts {Content-Type: text/html}
puts {}
puts "Get- (3): $code"
puts $convertedURL
exit
}
}
# REDIRECT
# puts --[array get env]--
if [regexp {^/zip/} $env(REQUEST_URI)] { ;# added by GJFB on 2021-01-09
set site $urlPropertyArray(archiveaddress) ;# commented by GJFB on 2022-07-12 - now above
array set ibiArray $urlPropertyArray(ibi)
set rep $ibiArray(rep)
puts "Location: http://$site/archive.cgi/$rep"
# http://gjfb:1905/archive.cgi/dpi.inpe.br/banon/1999/06.19.17.00
puts ""
} else {
puts "Location: $convertedURL"
return
}
} else {
# returntype == urlpropertylist
# agency strucure specific code
# agency resolver running
# added by GJFB on 2017-02-20 - used by the www.urlib.net resolver to get the url property list from the agency resolvers
# agency resolver
# >>> step 2 (input) of the agency structure communication scheme (agency resolver -> www.urlib.net resolver)
puts {Content-Type: text/plain}
puts {}
puts $urlPropertyList2
# =>
# archiveaddress gjfb.home:1905 contenttype Data ibi {rep urlib.net/www/2017/01.25.14.02 ibip J8LNKB5R7W/3N8UTK5} ibi.archiveservice {rep dpi.inpe.br/banon/1999/01.09.22.14} ibi.platformsoftware {rep dpi.inpe.br/banon/1998/08.02.08.56} state Original timestamp 2017-02-05T18:15:54Z url http://gjfb.home:1905/createpage.cgi/urlib.net/www/2017/01.25.14.02/doc/carta.tex urlkey 1488002121-5277263374485597
}
} m] {
if [regexp {.*} $m] {
# HTML code
puts {Content-Type: text/html}
} else {
# not an HTML code
puts {Content-Type: text/plain}
}
puts {}
puts $m
if 0 {global errorInfo; puts $errorInfo}
}
}
# Get- - end
# ----------------------------------------------------------------------
# CreateResultList
proc CreateResultList {token} {
global output
global xWaitQueue
upvar #0 $token state
set returnValue [string trimright $state(body)] ;# drop trailing new line
if ![string equal {} $returnValue] {
set output $returnValue
set xWaitQueue 1
}
}
# CreateResultList - end
# ----------------------------------------------------------------------