# UtilitiesStart
# Copyright for URLibService (c) 1995 - 2018,
# by Gerald Banon. All rights reserved.
# utilities for start
package provide dpi.inpe.br/banon/1998/08.02.08.56 2.1
# ----------------------------------------------------------------------
# LoadGlobalVariables
# portEntry value examples are:
# {} default
# 80
# 1905
# gjfb 800
# gjfb 19050
# called by post, start and others
proc LoadGlobalVariables {{portEntry {}}} {
global tcl_platform
global auto_path
global homePath
global bib2referRepository
global bibpessoal2referRepository
global citationKeyRepository
global compileWordsRepository
global col
global copyrightWarningRepository
global defaultAccessIconRepository
global defaultDocRepository
global defaultMetadataRepository
global englishMirrorRepository
global portugueseBrasilMirrorRepository
global englishRepository ;# needed for start and post
global englishWordsRepository
global isis2referRepository
global mirrorHomePageRepository
global referRepository
# global BibINPERepository
global searchRepository
global inflectionRepository ;# needed by MountSearch (used to find related records)
global URLibBannerSequenceRepository
global URLibServiceRepository
global downloadingEnvironmentRepository ;# used in MakeDownloadFile
global downloadForWindowsRepository ;# used in MakeDownloadFile
global downloadForSunOSRepository ;# used in MakeDownloadFile
global downloadForLinuxRepository ;# used in MakeDownloadFile
global parsingRepository
global samplingRepository
global sampledDocumentDBRepository
global repositoryNameDBRepository
# global localCollectionIndexDBRepository ;# commented by GJFB in 2010-08-04
global pythonCgiScriptForHistoryCaptureRepository ;# used in CreateBriefEntry
global OAIProtocolRepository ;# parent repository for the URLibService
global administratorPageRepository ;# parent repository for the URLibService
global MTD2-BRRepository
global XReferRepository
global resolverIndexRepository ;# added by GJFB in 2017-12-21 to identify if the URLibService is running or not the urlib.net resolver
global saveFlag ;# used by SaveRepositoryProperties, SaveReferenceTable and SaveMetadata
global serverAddress
global serverAddressWithIP
global urlibServerAddress ;# www.urlib.net and port - urlibServerAddress value is a constant and may be used any time
# global urlibServerAddressWithIP ;# ip and port of urlib.net
global standaloneModeFlag ;# used in CreateEnvironmentArray and GetURLPropertyList
global applicationName
global temporalResolution ;# set in this procedure and used in CreateIBI only
global installInitialCollection ;# set in this procedure
if 1 {
# useful when LoadGlobalVariables is called from outside the URLibService
if ![info exists homePath] {
regexp "(^.*)/col/" [pwd] m homePath
}
}
# set temporalResolution 60. ;# for minute
set temporalResolution 1. ;# for second
# set temporalResolution .001 ;# for millisecond
set saveFlag 0 ;# 0 means that no save is done after any update (save is done just when running Run-exit)
global allowedCommandList
## LeaveQueue and WaitQueue2 have been removed from allowedCommandList by GJFB in 2012-12-29 (see waitingFlag in MultipleSubmit)
## StartApacheServer has been removed from allowedCommandList by GJFB in 2013-12-02 because seems not to be used - StartApacheServerAfterSubmission is used instead
# StartApacheServer has been put again in allowedCommandList by GJFB in 2014-05-11 because it is uased (twice) in SPOK (see SPDialog.tcl)
# GetURLibServerAddress has been removed from allowedCommandList by GJFB in 2014-12-18 because $env(URLIB_SERVER_ADDR) is used instead
# ComputeSize has been removed from allowedCommandList by GJFB in 2018-03-09 because it doesn't require to be used via socket
# StoreArray has been removed by GJFB in 2018-03-30 for security reason - was probably just used in SPOK
set allowedCommandList {
AddMetadata
AddTwoFields
array
CheckModifiedTime
CheckUsernamePassword
Check-htpasswd
ComputeAccess
ComputeCurrentDownloadPermission
ComputeVersionState
ConvertPS2PDF
CreateBibINPEOutput
CreateCommonWordsRepList
CreateEnvironmentArray
CreateExtraFields
CreateIBI
CreateLanguageTable
CreateMirrorLanguageTable
CreatePermissionList
CreateReferenceTypeList
CreateRepMetadataRep
DeleteChildOutOfDateDocZip
DirectoryMTime
DisplayNumberOfEntries3
DownloadFileExists
ExtractHistogram
Find-
FindAllLanguageVersions
FindCopyrightRepositories
FindCurrentDownloadPermission
FindMetadataRep
FindMetadataRep2
FindPreferredLanguage
FindRepositoryNameFromIBI
GetAuthor
GetAuthorHomePage
GetCitedRepositoryList
GetCitingRepositoryList
GetDocumentState
GetEncodingName
GetEntry
GetFieldValue
GetHistogram
GetLastChange
GetLastUpdate
GetMetadata
GetMetadataArrayNames
GetMetadataLastUpdate
GetNumberOfVisits
GetOfficialIconRep
GetPermission
GetSampledDocumentDBServerAddress
GetTargetFile
GetURLibAdEMailAddress
GetURLibServiceSiteWithIP
GetVersionStamp
ImportRepository
incr
info
InformURLibSystem
InstallCGIScript
InstallRepository
lappend
LeaveQueue
Load2
LoadEnvironmentArray
LoadHostCollection
LoadRepository
MakeCgiScript2
MakeDownloadFile
MakeTargetKey
Migrate2
PostponeOneClickCount
PostponeSaveToDisk
ProvideRepository
RegisterRepository
RemoveMetadata
RemoveRepository
RepositoryMTime
ReturnFullServerNameIP
ReturnLoBiMiRep
ReturnNumberOfMetadataRep
ReturnReferModel
ReturnRepositoryName
ReturnStaticIPFlag
ReturnTargetFileContent
ReturnTheMostRecentVersions
ReturnTheMostRecentEntries2
ReturnType
ReturnWordListOfSearchExpression
Run-exit
SaveMetadata
SaveReferenceTable
SaveRepositoryProperties
SearchRepository
set
SetFieldValue3
SetAdvancedUserFromUserGroup
StartApacheServer
StartApacheServerAfterSubmission
StartLocalURLibServer
Store2
StorePassword2
StoreProgress
StoreRepository
StoreURLContent2
TestContentType
TestExecute
TestUpdateLastUpdate
TransferCopyright
unset
UpdateAccessFile
UpdateArchiveFile
UpdateArchivingPolicy
UpdateBase
UpdateCollection
UpdateDownloadFilesByAdministrator
UpdateMetadataFromBiblioDB
UpdateHistory
UpdateHostCollectionFieldValue
UpdateIBIToArchiveServiceArray
UpdateLastUpdate
UpdateMetadataBase
UpdateMultipleGlobalVariables
UpdateReferMetadata
UpdateReferenceTable
UpdateRepMetadataRep
UpdateRepository2
UpdateRepositoryListForPost
UpdateRepositoryProperties
UpdateVariables
WaitQueue2
}
global allowedCommandListForMultipleSubmit
# GetNumberOfItems is obsolete from 2011-01-15 - migration 2011-01-15
# FindSite is obsolete from 2012-05-05
# GetURLPropertyListList is obsolete from 2012-05-05
# PutURLibServerAddress is not used anymore since 2007
# new communication scheme (step 3)
# remove GetSiteStamp
# add ReturnConfirmation
set allowedCommandListForMultipleSubmit {
CaptureRepository
CheckPassword
CheckRegistration
FindBannerPath
FindRepositoryForFind-
FindSiteContainingTheOriginal
GetDocAccessLogFileContent
GetFieldValue2
GetFirstDay
GetHostCollectionSite
GetLanguageRepositories
GetMetadataRepositories
GetMostRecentMetadataRep
GetNumberOfReferences
GetOptimizedListOfSites
GetSiteInformation
GetSiteList
GetURLibServiceLastVersion
GetURLPropertyList
GetUserData
GetValue
GetVersionRegistrationTime
GetWordOccurrences
Identity
Identity2
MultipleArrayGet
MultipleLinesLoad2
RegisterRepositoryName
RegisterSampledDocument
ReturnConfirmation
ReturnHostCollection
ReturnSiteContainingTheOriginal
ReturnURLPropertyList
Select
Select2
UpdateSiteList
}
global fieldAttributeTable
# refer and BibTeX define the appearance of the respective dynamic format
# refer model is used to defined the fields that may be displayed within the canvas of the URLibService window or on-line (throught HTML forms)
# Refer BibTeX multiple lines refer model service stored
array set fieldAttributeTable { referencetype,1 1 referencetype,2 0 referencetype,3 0 referencetype,4 0 referencetype,5 0 }
array set fieldAttributeTable { thesistype,1 1 thesistype,2 0 thesistype,3 0 thesistype,4 0 thesistype,5 0 }
array set fieldAttributeTable { previousedition,1 1 previousedition,2 0 previousedition,3 0 previousedition,4 0 previousedition,5 0 }
array set fieldAttributeTable { nextedition,1 1 nextedition,2 0 nextedition,3 0 nextedition,4 0 nextedition,5 0 }
array set fieldAttributeTable { alternatepublication,1 1 alternatepublication,2 0 alternatepublication,3 0 alternatepublication,4 0 alternatepublication,5 0 } ;# ,2 must be 0
array set fieldAttributeTable { stageofalternatepublication,1 1 stageofalternatepublication,2 0 stageofalternatepublication,3 0 stageofalternatepublication,4 0 stageofalternatepublication,5 0 } ;# ,2 must be 0
array set fieldAttributeTable { targetfile,1 1 targetfile,2 1 targetfile,3 0 targetfile,4 0 targetfile,5 0 }
array set fieldAttributeTable { citationkey,1 0 citationkey,2 0 citationkey,3 0 citationkey,4 0 citationkey,5 0 }
array set fieldAttributeTable { site,1 0 site,2 0 site,3 0 site,4 0 site,5 0 }
array set fieldAttributeTable { isbn,1 1 isbn,2 1 isbn,3 1 isbn,4 1 isbn,5 0 }
array set fieldAttributeTable { issn,1 1 issn,2 1 issn,3 1 issn,4 1 issn,5 0 }
array set fieldAttributeTable { copyholder,1 0 copyholder,2 1 copyholder,3 0 copyholder,4 1 copyholder,5 0 }
array set fieldAttributeTable { childrepositories,1 0 childrepositories,2 0 childrepositories,3 0 childrepositories,4 0 childrepositories,5 0 }
# array set fieldAttributeTable { sourcerepositories,1 1 sourcerepositories,2 1 sourcerepositories,3 0 sourcerepositories,4 0 sourcerepositories,5 0 }
array set fieldAttributeTable { databaserepository,1 0 databaserepository,2 1 databaserepository,3 0 databaserepository,4 0 databaserepository,5 0 }
array set fieldAttributeTable { e-mailaddress,1 0 e-mailaddress,2 0 e-mailaddress,3 0 e-mailaddress,4 1 e-mailaddress,5 0 }
array set fieldAttributeTable { secondarykey,1 0 secondarykey,2 0 secondarykey,3 0 secondarykey,4 1 secondarykey,5 0 }
array set fieldAttributeTable { holdercode,1 0 holdercode,2 0 holdercode,3 0 holdercode,4 1 holdercode,5 0 }
array set fieldAttributeTable { secondarytype,1 0 secondarytype,2 0 secondarytype,3 0 secondarytype,4 1 secondarytype,5 0 }
array set fieldAttributeTable { tertiarytype,1 0 tertiarytype,2 0 tertiarytype,3 0 tertiarytype,4 1 tertiarytype,5 0 }
array set fieldAttributeTable { subject,1 0 subject,2 0 subject,3 0 subject,4 1 subject,5 0 }
array set fieldAttributeTable { session,1 0 session,2 0 session,3 0 session,4 1 session,5 0 }
array set fieldAttributeTable { dissemination,1 0 dissemination,2 0 dissemination,3 0 dissemination,4 1 dissemination,5 0 }
array set fieldAttributeTable { format,1 0 format,2 0 format,3 0 format,4 1 format,5 0 }
array set fieldAttributeTable { secondarydate,1 0 secondarydate,2 0 secondarydate,3 0 secondarydate,4 1 secondarydate,5 0 }
array set fieldAttributeTable { area,1 0 area,2 1 area,3 0 area,4 1 area,5 0 }
array set fieldAttributeTable { resumeid,1 0 resumeid,2 0 resumeid,3 1 resumeid,4 1 resumeid,5 0 }
array set fieldAttributeTable { orcid,1 0 orcid,2 0 orcid,3 1 orcid,4 1 orcid,5 0 }
array set fieldAttributeTable { group,1 0 group,2 0 group,3 1 group,4 1 group,5 0 }
array set fieldAttributeTable { affiliation,1 1 affiliation,2 1 affiliation,3 1 affiliation,4 1 affiliation,5 0 }
array set fieldAttributeTable { electronicmailaddress,1 1 electronicmailaddress,2 1 electronicmailaddress,3 1 electronicmailaddress,4 1 electronicmailaddress,5 0 } ;# ,2 must be 0
array set fieldAttributeTable { project,1 0 project,2 0 project,3 0 project,4 1 project,5 0 }
array set fieldAttributeTable { course,1 0 course,2 0 course,3 0 course,4 1 course,5 0 }
array set fieldAttributeTable { usergroup,1 0 usergroup,2 0 usergroup,3 1 usergroup,4 1 usergroup,5 0 }
array set fieldAttributeTable { documentstage,1 0 documentstage,2 0 documentstage,3 0 documentstage,4 1 documentstage,5 0 }
array set fieldAttributeTable { progress,1 0 progress,2 0 progress,3 0 progress,4 1 progress,5 0 }
array set fieldAttributeTable { sponsor,1 0 sponsor,2 0 sponsor,3 1 sponsor,4 1 sponsor,5 0 }
array set fieldAttributeTable { doi,1 0 doi,2 1 doi,3 1 doi,4 1 doi,5 0 }
array set fieldAttributeTable { accessdate,1 0 accessdate,2 1 accessdate,3 0 accessdate,4 1 accessdate,5 0 }
array set fieldAttributeTable { mark,1 0 mark,2 0 mark,3 0 mark,4 1 mark,5 0 } ;# ,2 must be 0
array set fieldAttributeTable { secondarymark,1 0 secondarymark,2 0 secondarymark,3 0 secondarymark,4 1 secondarymark,5 0 } ;# ,2 must be 0
array set fieldAttributeTable { tertiarymark,1 0 tertiarymark,2 0 tertiarymark,3 0 tertiarymark,4 1 tertiarymark,5 0 } ;# ,2 must be 0
array set fieldAttributeTable { index,1 0 index,2 0 index,3 0 index,4 0 index,5 0 }
array set fieldAttributeTable { lastupdate,1 0 lastupdate,2 0 lastupdate,3 0 lastupdate,4 0 lastupdate,5 1 }
array set fieldAttributeTable { metadatalastupdate,1 0 metadatalastupdate,2 0 metadatalastupdate,3 0 metadatalastupdate,4 0 metadatalastupdate,5 1 }
array set fieldAttributeTable { size,1 0 size,2 0 size,3 0 size,4 0 size,5 1 }
array set fieldAttributeTable { numberoffiles,1 0 numberoffiles,2 0 numberoffiles,3 0 numberoffiles,4 0 numberoffiles,5 1 }
array set fieldAttributeTable { language,1 1 language,2 1 language,3 0 language,4 1 language,5 1 }
array set fieldAttributeTable { contenttype,1 0 contenttype,2 0 contenttype,3 0 contenttype,4 1 contenttype,5 1 }
array set fieldAttributeTable { hostcollection,1 0 hostcollection,2 0 hostcollection,3 0 hostcollection,4 0 hostcollection,5 1 }
array set fieldAttributeTable { parentrepositories,1 0 parentrepositories,2 0 parentrepositories,3 0 parentrepositories,4 1 parentrepositories,5 1 }
array set fieldAttributeTable { username,1 0 username,2 0 username,3 0 username,4 0 username,5 1 }
array set fieldAttributeTable { readergroup,1 0 readergroup,2 0 readergroup,3 1 readergroup,4 1 readergroup,5 1 } ;# ,2 must be 0
array set fieldAttributeTable { readpermission,1 0 readpermission,2 0 readpermission,3 0 readpermission,4 1 readpermission,5 1 }
array set fieldAttributeTable { visibility,1 0 visibility,2 0 visibility,3 0 visibility,4 1 visibility,5 1 } ;# ,2 must be 0
array set fieldAttributeTable { mirrorrepository,1 0 mirrorrepository,2 0 mirrorrepository,3 0 mirrorrepository,4 1 mirrorrepository,5 0 } ;# ,2 must be 0
array set fieldAttributeTable { supervisor,1 0 supervisor,2 0 supervisor,3 1 supervisor,4 0 supervisor,5 0 }
array set fieldAttributeTable { lasthostcollection,1 0 lasthostcollection,2 0 lasthostcollection,3 0 lasthostcollection,4 0 lasthostcollection,5 0 }
array set fieldAttributeTable { identifier,1 0 identifier,2 0 identifier,3 0 identifier,4 0 identifier,5 1 }
array set fieldAttributeTable { lineage,1 1 lineage,2 0 lineage,3 1 lineage,4 1 lineage,5 0 }
array set fieldAttributeTable { transferableflag,1 0 transferableflag,2 0 transferableflag,3 0 transferableflag,4 0 transferableflag,5 1 } ;# ,2 must be 0
array set fieldAttributeTable { copyright,1 0 copyright,2 0 copyright,3 0 copyright,4 1 copyright,5 1 }
array set fieldAttributeTable { rightsholder,1 0 rightsholder,2 0 rightsholder,3 0 rightsholder,4 1 rightsholder,5 0 }
array set fieldAttributeTable { versiontype,1 0 versiontype,2 0 versiontype,3 0 versiontype,4 1 versiontype,5 0 }
array set fieldAttributeTable { archivingpolicy,1 0 archivingpolicy,2 0 archivingpolicy,3 0 archivingpolicy,4 1 archivingpolicy,5 0 }
array set fieldAttributeTable { nexthigherunit,1 0 nexthigherunit,2 0 nexthigherunit,3 1 nexthigherunit,4 1 nexthigherunit,5 0 }
array set fieldAttributeTable { previouslowerunit,1 0 previouslowerunit,2 0 previouslowerunit,3 1 previouslowerunit,4 1 previouslowerunit,5 0 }
array set fieldAttributeTable { agreement,1 0 agreement,2 0 agreement,3 0 agreement,4 0 agreement,5 0 }
array set fieldAttributeTable { descriptionlevel,1 0 descriptionlevel,2 0 descriptionlevel,3 0 descriptionlevel,4 1 descriptionlevel,5 0 }
array set fieldAttributeTable { archivist,1 0 archivist,2 0 archivist,3 1 archivist,4 1 archivist,5 0 }
array set fieldAttributeTable { creatorhistory,1 0 creatorhistory,2 0 creatorhistory,3 0 creatorhistory,4 1 creatorhistory,5 0 }
array set fieldAttributeTable { textlanguage,1 0 textlanguage,2 0 textlanguage,3 0 textlanguage,4 0 textlanguage,5 0 }
array set fieldAttributeTable { shorttitle,1 0 shorttitle,2 0 shorttitle,3 0 shorttitle,4 1 shorttitle,5 0 }
array set fieldAttributeTable { parameterlist,1 0 parameterlist,2 0 parameterlist,3 0 parameterlist,4 1 parameterlist,5 0 }
# Refer BibTeX multiple lines refer model service stored
global multipleLineFieldNameList
global authorFieldNameList
global multipleLineReferFieldNamePattern
global multipleLineReferFieldNamePattern2
global multipleLineReferFieldNamePatternForCreator
# multipleLineFieldNameList
# set multipleLineFieldNameList {creatorname author cartographer committee editor programmer reporter serieseditor source translator notes supervisor component runby program receiver fullname} ;# commented by GJFB in 2013-01-20
if 1 {
set multipleLineFieldNameList {}
set multipleLineFieldNameList [concat $multipleLineFieldNameList {author cartographer creatorname diretor editor programmer reporter runby fullname}] ;# %A
# set multipleLineFieldNameList [concat $multipleLineFieldNameList {committee editor institution program seriesdirector serieseditor source}] ;# %E
set multipleLineFieldNameList [concat $multipleLineFieldNameList {committee editor program seriesdirector serieseditor source}] ;# %E
set multipleLineFieldNameList [concat $multipleLineFieldNameList {serieseditor producer receiver}] ;# %Y
set multipleLineFieldNameList [concat $multipleLineFieldNameList {translator component photographer}] ;# %?
set multipleLineFieldNameList [concat $multipleLineFieldNameList {notes}] ;# %O
set multipleLineFieldNameList [lsort -unique $multipleLineFieldNameList]
}
foreach item [array names fieldAttributeTable *,3] {
# affiliation archivist doi electronicmailaddress group isbn issn lineage readergroup resumeid orcid sponsor supervisor usergroup
if $fieldAttributeTable($item) {
regsub {,3} $item {} fieldName
lappend multipleLineFieldNameList $fieldName
}
}
foreach fieldName $multipleLineFieldNameList {
# add FIRST for multiple line fields
# settings below are used in the display of xrefer
array set fieldAttributeTable [list first$fieldName,1 0 first$fieldName,2 0 first$fieldName,3 1 first$fieldName,4 0 first$fieldName,5 0]
lappend multipleLineFieldNameList first$fieldName
}
# authorFieldNameList
# creatorFieldNameList
## defined also in col/dpi.inpe.br/banon-pc@1905/2005/02.19.00.40/doc/cgi/script.tcl
set creatorFieldNameList {author cartographer creatorname diretor editor programmer reporter runby fullname} ;# %A
# author fields (the set of multiple line fields includes the set of author fields)
# set authorFieldNameList {archivist author cartographer committee creatorname diretor editor programmer reporter serieseditor source translator notes supervisor component runby fullname} ;# commented by GJFB in 2013-01-20
if 1 {
set authorFieldNameList {}
set authorFieldNameList [concat $authorFieldNameList $creatorFieldNameList] ;# %A
set authorFieldNameList [concat $authorFieldNameList {committee editor seriesdirector serieseditor source}] ;# %E - program institution
set authorFieldNameList [concat $authorFieldNameList {serieseditor producer}] ;# %Y - receiver
set authorFieldNameList [concat $authorFieldNameList {translator component photographer}] ;# %?
set authorFieldNameList [lsort -unique $authorFieldNameList]
}
foreach item [array names fieldAttributeTable *,3] {
# add affiliation archivist doi electronicmailaddress group isbn issn lineage readergroup resumeid orcid sponsor supervisor usergroup
if $fieldAttributeTable($item) {
regsub {,3} $item {} fieldName
if {[lsearch {affiliation doi electronicmailaddress group isbn issn lineage readergroup resumeid orcid usergroup} $fieldName] == -1} {
# exclude affiliation doi electronicmailaddress group isbn issn...
# author field: archivist sponsor supervisor
lappend authorFieldNameList $fieldName
}
}
}
# multipleLineReferFieldNamePattern
set multipleLineReferFieldNamePattern {A|E|Y|\?|O}
foreach item [array names fieldAttributeTable *,3] {
# add affiliation archivist doi electronicmailaddress group isbn issn lineage readergroup resumeid orcid sponsor supervisor usergroup
if $fieldAttributeTable($item) {
regsub {,3} $item {} fieldName
if [regexp {^first} $fieldName] {continue} ;# exclude the virtual fields beginning with first
append multipleLineReferFieldNamePattern |@$fieldName
}
}
# multipleLineReferFieldNamePattern2
# created by GJFB in 2018-01-07 to allow the two forms (one line or multiple lines) of %@previouslowerunit in @metadata.refer or in filling forms
set multipleLineReferFieldNamePattern2 {A|E|Y|\?|O}
foreach item [array names fieldAttributeTable *,3] {
# add affiliation archivist doi electronicmailaddress group isbn issn lineage readergroup resumeid orcid sponsor supervisor usergroup
if $fieldAttributeTable($item) {
regsub {,3} $item {} fieldName
if [regexp {^first} $fieldName] {continue} ;# exclude the virtual fields beginning with first
if [regexp {^nexthigherunit$|^previouslowerunit$} $fieldName] {continue} ;# exclude nexthigherunit and previouslowerunit
append multipleLineReferFieldNamePattern2 |@$fieldName
}
}
# multipleLineReferFieldNamePatternForCreator
set multipleLineReferFieldNamePatternForCreator {A|E|Y|\?|@archivist}
# see also AEY? pattern in LoadMetadata (utilities2.tcl) and in SampleFile (Sampling.tcl)
set col ../../../../..
set bib2referRepository dpi.inpe.br/banon/1999/07.17.00.02
set isis2referRepository dpi.inpe.br/banon/2001/03.25.01.06
set bibpessoal2referRepository iconet.com.br/banon/2001/11.24.15.12
set citationKeyRepository dpi.inpe.br/banon/1999/07.11.21.09
set compileWordsRepository dpi.inpe.br/banon/1999/04.25.14.34
set copyrightWarningRepository dpi.inpe.br/banon/2000/02.20.10.08 ;# Default copyright warning for the URLib collection
set defaultAccessIconRepository dpi.inpe.br/banon/1999/12.15.21.29
set defaultDocRepository dpi.inpe.br/banon/1999/09.19.18.20
set defaultMetadataRepository dpi.inpe.br/banon/1999/09.12.15.10
set englishMirrorRepository dpi.inpe.br/banon/1999/05.03.22.11
set portugueseBrasilMirrorRepository dpi.inpe.br/banon/1999/06.19.22.43
set englishRepository dpi.inpe.br/banon/1998/05.03.10.10
set englishWordsRepository dpi.inpe.br/banon/1999/04.25.10.22
set mirrorHomePageRepository dpi.inpe.br/banon/2000/01.23.20.24
set referRepository dpi.inpe.br/banon/1999/08.08.19.14
# set BibINPERepository iconet.com.br/banon/2003/04.18.13.10
set searchRepository dpi.inpe.br/banon/1999/04.21.17.06
set inflectionRepository dpi.inpe.br/banon-pc3@80/2010/02.03.13.25
set URLibBannerSequenceRepository dpi.inpe.br/banon/2000/02.05.09.57
set URLibServiceRepository dpi.inpe.br/banon/1998/08.02.08.56
# set URLibServiceUserGuideRepository iconet.com.br/banon/2000/12.31.20.38
set downloadingEnvironmentRepository iconet.com.br/banon/2000/12.30.22.40
set downloadForWindowsRepository iconet.com.br/banon/2002/02.02.09.41
set downloadForSunOSRepository iconet.com.br/banon/2002/02.02.20.42
set downloadForLinuxRepository iconet.com.br/banon/2002/02.04.12.37
set parsingRepository iconet.com.br/banon/2001/11.24.08.30
set samplingRepository iconet.com.br/banon/2001/11.04.16.39
set sampledDocumentDBRepository iconet.com.br/banon/2002/02.13.10.35
# set repositoryNameDBRepository iconet.com.br/banon/2002/01.25.22.23 ;# for testing repository registration
set repositoryNameDBRepository iconet.com.br/banon/2002/07.15.14.03
# set localCollectionIndexDBRepository iconet.com.br/banon/2002/11.23.19.51 ;# commented by GJFB in 2010-08-04
set pythonCgiScriptForHistoryCaptureRepository dpi.inpe.br/juliana/2003/08.18.12.28
set OAIProtocolRepository iconet.com.br/banon/2003/11.21.21.08
set administratorPageRepository dpi.inpe.br/banon-pc@1905/2005/02.19.00.40
set MTD2-BRRepository iconet.com.br/banon/2006/06.22.00.30
set XReferRepository iconet.com.br/banon/2004/11.15.21.08
set resolverIndexRepository dpi.inpe.br/banon/2004/02.16.09.29 ;# added by GJFB in 2017-12-21 to identify if the URLibService is running or not the urlib.net resolver
global mirrorLanguageTable
array set mirrorLanguageTable [CreateMirrorLanguageTable]
global webLanguageTable
array set webLanguageTable [CreateWebLanguageTable]
# update here (and in CreateWebLanguageTable), when including a new language
global masterLanguagePattern ;# used by CreateBibTeXEntry (cf., utilitiesMirror.tcl)
set masterLanguagePattern master|mestrado
global apacheDirectoryPath
global apacheMimeTypesFilePath
global apacheMagicFilePath
global apacheIconDirectoryPath
global apachePath
global apacheLibDirectoryPath
global phpiniDirectoryPath
global apacheRepository ;# used by ControlBCButtonState and post
global htpasswdPath
# global htpasswdRepository
# global apacheVersion ;# 1.3.1 1.3.3 1.3.11 1.3.20 1.3.22
global linuxDistribution
global tclPath
global wishPath
global tclRepository
global pythonPath
# global pythonRepository
global zipPath
global zipRepository
global unZipPath
global unZipRepository ;# needed by start
global unRarPath
# Installation of a new Linux distribution
# set in this file:
# apacheMimeTypesFilePath mime.types
# apacheMagicFilePath magic
# apacheIconDirectoryPath icons
# apachePath httpd
# apacheLibDirectoryPath apache ? (use by LoadModule directive)
# htpasswdPath htpasswd ?
# linuxDistribution Mandrake
# tclPath tclsh
# wishPath wish
# zipPath zip
## set in ExtractURLibService:
# unZipPath unzip
# set in SPDialog.tcl:
# environmentArray(netscape) netscape
# get output of the following commands:
# httpd -v (see post)
# hostname (see in this file the FindInternetAddress procedure (in utilitiesStart.tcl))
## domainname
# nslookup (see in this file the FindInternetAddress procedure)
## /usr/bin/nslookup
## cat /etc/hosts
## ypcat hosts
## /sbin/ifconfig
# whoami (see CreateUser&GroupDirectives in StartServer.tcl)
# Installation of a new Linux distribution - end
global knownPathArray
# source knownPathArray.tcl ;# needed by SetPath
source $homePath/col/$URLibServiceRepository/doc/knownPathArray.tcl ;# needed by SetPath
# Linux, Slackware, Apache/2.2.13, mtc-m18.sid.inpe.br
# Linux, Slackware, Apache/2.2.15, mtc-m16.sid.inpe.br
# Linux, Slackware, Apache/2.2.16, mtc-m17.sid.inpe.br
# Linux, Slackware, Apache/2.2.19, mtc-m20.sid.inpe.br
# Linux, Slackware, Apache/2.2.22, mtc-m21.sid.inpe.br
# Linux, Centos, Apache/2.2.15, md-m09.sid.inpe.br
## Linux, Centos, Apache/2.4.6, plutao.sid.inpe.br
set apachePath [SetPath httpd #0]
set htpasswdPath [SetPath htpasswd #0]
set apacheLibDirectoryPath [SetPath httpdLibDirectory #0]
set apacheMimeTypesFilePath [SetPath httpdMimeTypesFile #0]
set apacheMagicFilePath [SetPath httpdMagicFile #0]
set apacheIconDirectoryPath [SetPath httpdIconDirectory #0]
set phpiniDirectoryPath [SetPath phpiniDirectory #0]
# if {$tcl_platform(os) == "Linux"} {
# if [file owned $apachePath] {exec chmod 774 $apachePath} ;# needed after Install Repository (IR)
# if [file owned $htpasswdPath] {exec chmod 774 $htpasswdPath} ;# needed after Install Repository (IR)
# }
set linuxDistribution {}
set apacheRepository {}
package require http
set zipRepository {}
set zipExec zip
# puts --$apachePath--
# puts --$htpasswdPath--
# puts --$apacheLibDirectoryPath--
# puts --$apacheMimeTypesFilePath--
# puts --$apacheMagicFilePath--
# puts --$apacheIconDirectoryPath--
# puts --$phpiniDirectoryPath--
# exit
# if {[string equal {} $apachePath] || \
# [string equal {} $htpasswdPath] || \
# [string equal {} $apacheLibDirectoryPath] || \
# [string equal {} $apacheMimeTypesFilePath] || \
# [string equal {} $apacheMagicFilePath] || \
# [string equal {} $apacheIconDirectoryPath] || \
# [string equal {} $phpiniDirectoryPath]} # ;# commented by GJFB in 2018-10-15
if {[string equal {} $apachePath] && \
([string equal {} $htpasswdPath] || \
[string equal {} $apacheLibDirectoryPath] || \
[string equal {} $apacheMimeTypesFilePath] || \
[string equal {} $apacheMagicFilePath] || \
[string equal {} $apacheIconDirectoryPath] || \
[string equal {} $phpiniDirectoryPath])} { ;# added by GJFB in 2018-10-15 - try old code only if apachePath was empty
# try old code
# Windows
if {$tcl_platform(platform) == "windows"} {
if [file isdirectory {C:/Program Files/Apache Group/Apache2x}] {
# didn't work
set apacheMimeTypesFilePath {C:/Program Files/Apache Group/Apache2/conf/mime.types}
set apacheMagicFilePath {C:/Program Files/Apache Group/Apache2/conf/magic}
set apacheIconDirectoryPath {C:/Program Files/Apache Group/Apache2/icons}
set apachePath {C:/Program Files/Apache Group/Apache2/bin/Apache.exe}
set apacheLibDirectoryPath {C:/Program Files/Apache Group/Apache2/modules}
# set apacheVersion 2.0.44
} elseif {[file isdirectory $homePath/col/iconet.com.br/banon/2005/10.07.22.52x]} {
# banon-pc2 - apache 2.0.54
set apacheRepository iconet.com.br/banon/2005/10.07.22.52
set apacheExec Apache.exe
set apacheMimeTypesFilePath $homePath/col/$apacheRepository/doc/Apache2/conf/mime.types
set apacheMagicFilePath $homePath/col/$apacheRepository/doc/Apache2/conf/magic
set apacheIconDirectoryPath $homePath/col/$apacheRepository/doc/Apache2/icons ;# must be homePath (because of Alias Apache directive)
set apachePath $homePath/col/$apacheRepository/doc/Apache2/bin/$apacheExec
set apacheLibDirectoryPath $homePath/col/$apacheRepository/doc/Apache2/modules ;# needed for php
# set apacheVersion 2.0.54
} elseif {[file isdirectory {C:/Program Files/Apache Group/Apache}]} {
# notebook
set apacheMimeTypesFilePath {C:/Program Files/Apache Group/Apache/conf/mime.types}
set apacheMagicFilePath {C:/Program Files/Apache Group/Apache/conf/magic}
set apacheIconDirectoryPath {C:/Program Files/Apache Group/Apache/icons}
set apachePath {C:/Program Files/Apache Group/Apache/Apache.exe}
set apacheLibDirectoryPath {C:/Program Files/Apache Group/Apache/modules}
# set apacheVersion 1.3.27
} elseif {[file isdirectory $homePath/col/iconet.com.br/banon/2003/03.16.13.05]} {
# Lise
# banon-pc2
set apacheRepository iconet.com.br/banon/2003/03.16.13.05
set apacheExec Apache.exe
set apacheMimeTypesFilePath $homePath/col/$apacheRepository/doc/conf/mime.types
set apacheMagicFilePath $homePath/col/$apacheRepository/doc/conf/magic
set apacheIconDirectoryPath $homePath/col/$apacheRepository/doc/icons ;# must be homePath (because of Alias Apache directive)
set apachePath $homePath/col/$apacheRepository/doc/$apacheExec
set apacheLibDirectoryPath $homePath/col/$apacheRepository/doc/modules ;# needed for php
# set apacheVersion 1.3.27
# # elseif [file isdirectory $homePath/col/iconet.com.br/banon/2001/12.28.20.28] #
# set apacheRepository iconet.com.br/banon/2001/12.28.20.28
# set apacheExec Apache.exe
# set apacheMimeTypesFilePath $homePath/col/$apacheRepository/doc/conf/mime.types
# set apacheMagicFilePath $homePath/col/$apacheRepository/doc/conf/magic
# set apacheIconDirectoryPath $homePath/col/$apacheRepository/doc/icons ;# must be homePath (because of Alias Apache directive)
# set apachePath $homePath/col/$apacheRepository/doc/$apacheExec
## set apacheVersion 1.3.22
} else {
set apacheRepository dpi.inpe.br/banon/1999/01.02.16.35
set apacheExec Apache.exe
set apacheMimeTypesFilePath $homePath/col/$apacheRepository/doc/conf/mime.types
set apacheMagicFilePath $homePath/col/$apacheRepository/doc/conf/magic
set apacheIconDirectoryPath $homePath/col/$apacheRepository/doc/icons ;# must be homePath (because of Alias Apache directive)
set apachePath $homePath/col/$apacheRepository/doc/$apacheExec
# set apacheVersion 1.3.3
}
if [file isdirectory $homePath/col/iconet.com.br/banon/2002/12.15.15.27] {
# just used with the notebook
set htpasswdExec htpasswd.exe
set htpasswdRepository iconet.com.br/banon/2002/12.15.15.27
set htpasswdPath $homePath/col/$htpasswdRepository/doc/$htpasswdExec
} elseif {[file isdirectory {C:/Program Files/Apache Group/Apache}]} {
set htpasswdPath {C:/Program Files/Apache Group/Apache/bin/htpasswd.exe}
} elseif {[file isdirectory $homePath/col/iconet.com.br/banon/2003/03.16.13.05]} {
# 1.3.27
set apacheRepository iconet.com.br/banon/2003/03.16.13.05
set htpasswdPath $homePath/col/$apacheRepository/doc/bin/htpasswd.exe
}
if 0 {
# Juliana's work
set pythonExec python.exe
if [file isdirectory $homePath/col/dpi.inpe.br/juliana/2003/08.15.10.26] {
set pythonRepository dpi.inpe.br/juliana/2003/08.15.10.26
} else {
set pythonRepository {}
}
}
## see ExtractURLibService.tcl
# set unZipExec unzip
# set unZipRepository dpi.inpe.br/banon/2000/08.09.16.24
set zipRepository dpi.inpe.br/banon/1998/03.07.08.57
}
# Windows - end
# Unix
if {$tcl_platform(platform) == "unix"} {
# exec umask 2 ;# gives permission to the group - doesn't work here
set phpiniDirectoryPath {}
if {$tcl_platform(os) == "SunOS"} {
# SunOS
# set apacheConfDirectoryPath /usr/local/apache
set apacheMimeTypesFilePath /usr/local/apache/conf/mime.types
set apacheMagicFilePath /usr/local/apache/conf/magic
set apacheIconDirectoryPath /usr/local/apache/icons
set apachePath /usr/local/apache/bin/httpd
set apacheLibDirectoryPath /usr/local/apache
set htpasswdPath /usr/local/apache/bin/htpasswd
# set tclPath /usr/local/bin/tclsh
# set wishPath /usr/local/bin/wish
# set tclRepository {}
if 0 {
# Juliana's work (hermes:1910)
set pythonExec python
if [file isdirectory $homePath/col/dpi.inpe.br/banon/2004/06.22.11.51] {
set pythonRepository dpi.inpe.br/banon/2004/06.22.11.51
} else {
set pythonRepository {}
}
}
## see ExtractURLibService.tcl
# set unZipExec unzip
# set unZipRepository dpi.inpe.br/banon/2000/08.09.17.10
set zipRepository dpi.inpe.br/vagner/1999/07.22.16.12
if {[file isdirectory $homePath/col/$zipRepository/doc]} {
# it is better to get zip from a repository in order to
# capture its version when registering a document
# set zipExec zip
} elseif [file exists /usr/local/bin/zip] {
# set zipPath /usr/local/bin/zip ;# now in knownPathArray
set zipRepository {}
} else {
set zipRepository {}
}
# SunOS - end
} elseif {$tcl_platform(os) == "Linux"} {
# Linux
if [file isdirectory $homePath/col/dpi.inpe.br/banon-pc2@80/2006/08.03.13.25x] {
# x is to discard apache 1.3.37 because it doesn't work without a complicated installation of the php module libraries
# apache 1.3.37 with socket and mail, coming from Mandrake at netuno.dpi.inpe.br
set apacheRepository dpi.inpe.br/banon-pc2@80/2006/08.03.13.25
set apacheExec httpd
set apacheMimeTypesFilePath $homePath/col/$apacheRepository/doc/conf/mime.types
set apacheMagicFilePath $homePath/col/$apacheRepository/doc/conf/magic
set apacheIconDirectoryPath $homePath/col/$apacheRepository/doc/icons
set apachePath $homePath/col/$apacheRepository/doc/bin/$apacheExec
set apacheLibDirectoryPath $homePath/col/$apacheRepository/doc/libexec
set phpiniDirectoryPath $homePath/col/$apacheRepository/doc/bin
set htpasswdPath $homePath/col/$apacheRepository/doc/bin/htpasswd
set linuxDistribution Mandrake
if [file owned $apachePath] {exec chmod 774 $apachePath}
if [file owned $htpasswdPath] {exec chmod 774 $htpasswdPath}
} elseif {[file isdirectory $homePath/col/dpi.inpe.br/banon-pc2@1905/2006/05.18.15.44x]} {
# x is to discard apache 1.3.35 because it doesn't work without a complicated installation of the php module libraries
# apache 1.3.35 with socket, coming from Mandrake at dpi.inpe.br
set apacheRepository dpi.inpe.br/banon-pc2@1905/2006/05.18.15.44
set apacheExec httpd
set apacheMimeTypesFilePath $homePath/col/$apacheRepository/doc/conf/mime.types
set apacheMagicFilePath $homePath/col/$apacheRepository/doc/conf/magic
set apacheIconDirectoryPath $homePath/col/$apacheRepository/doc/icons
set apachePath $homePath/col/$apacheRepository/doc/bin/$apacheExec
set apacheLibDirectoryPath $homePath/col/$apacheRepository/doc/libexec
set phpiniDirectoryPath $homePath/col/$apacheRepository/doc/bin
set htpasswdPath $homePath/col/$apacheRepository/doc/bin/htpasswd
set linuxDistribution Mandrake
if [file owned $apachePath] {exec chmod 774 $apachePath}
if [file owned $htpasswdPath] {exec chmod 774 $htpasswdPath}
} elseif {[file isdirectory /usr/local/apache/icons]} {
# Mandrake distribution (marte.dpi.inpe.br)
# Mandrake distribution (hermes2.dpi.inpe.br)
# Mandrake distribution (plutao.dpi.inpe.br)
# (bibdigital.sid.inpe.br 2014-10-14)
set apacheMimeTypesFilePath /usr/local/apache/conf/mime.types
set apacheMagicFilePath /usr/local/apache/conf/magic
set apacheIconDirectoryPath /usr/local/apache/icons
set apachePath /usr/local/apache/bin/httpd
set apacheLibDirectoryPath /usr/local/apache/libexec
set htpasswdPath /usr/local/apache/bin/htpasswd
set linuxDistribution Mandrake
} elseif {[file isdirectory $homePath/col/iconet.com.br/banon/2005/12.06.21.35]} {
# apache 1.3.33 coming from Mandrake at dpi.inpe.br
set apacheRepository iconet.com.br/banon/2005/12.06.21.35
set apacheExec httpd
set apacheMimeTypesFilePath $homePath/col/$apacheRepository/doc/conf/mime.types
set apacheMagicFilePath $homePath/col/$apacheRepository/doc/conf/magic
set apacheIconDirectoryPath $homePath/col/$apacheRepository/doc/icons
set apachePath $homePath/col/$apacheRepository/doc/bin/$apacheExec
set htpasswdPath $homePath/col/$apacheRepository/doc/bin/htpasswd
set linuxDistribution Mandrake
if [file owned $apachePath] {exec chmod 774 $apachePath}
if [file owned $htpasswdPath] {exec chmod 774 $htpasswdPath}
} elseif {[file isdirectory $homePath/col/iconet.com.br/banon/2005/11.24.22.46]} {
# apache 2.0.53
# doesn't work because httpd2 needs shared libraries
set apacheRepository iconet.com.br/banon/2005/11.24.22.46
set apacheExec httpd2
set apacheDirectoryPath $homePath/col/$apacheRepository/doc/Apache2
set apacheMimeTypesFilePath $homePath/col/$apacheRepository/doc/Apache2/conf/apache-mime.types
set apacheMagicFilePath $homePath/col/$apacheRepository/doc/Apache2/conf/magic
set apacheIconDirectoryPath $homePath/col/$apacheRepository/doc/Apache2/icons ;# must be homePath (because of Alias Apache directive)
set apachePath $homePath/col/$apacheRepository/doc/Apache2/bin/$apacheExec
set apacheLibDirectoryPath $homePath/col/$apacheRepository/doc/Apache2/modules
set htpasswdPath $homePath/col/$apacheRepository/doc/Apache2/bin/htpasswd
set linuxDistribution Mandrake
} elseif {[file isdirectory /var/www/icons]} {
# Mandrake distribution (gemini.dpi.inpe.br)
# set apacheConfDirectoryPath /etc/httpd
set apacheMimeTypesFilePath /etc/httpd/conf/mime.types
set apacheMagicFilePath /etc/httpd/conf/magic
set apacheIconDirectoryPath /var/www/icons
set apachePath /usr/sbin/httpd
set apacheLibDirectoryPath /usr/lib/apache
set htpasswdPath /usr/sbin/htpasswd ;# ?
set linuxDistribution Mandrake
} elseif {[file isdirectory /home/httpd/icons]} {
# Conectiva distribution
# set apacheConfDirectoryPath /etc/httpd
set apacheMimeTypesFilePath /etc/mime.types
set apacheMagicFilePath /etc/httpd/conf/magic
set apacheIconDirectoryPath /home/httpd/icons
set apachePath /usr/sbin/httpd
set apacheLibDirectoryPath /usr/lib/apache
set htpasswdPath /usr/sbin/htpasswd ;# ?
set linuxDistribution Conectiva
} elseif {[file isdirectory /usr/local/apache2/icons]} {
# Slackware 8 distribution
# set apacheConfDirectoryPath /usr/local/apache2
set apacheMimeTypesFilePath /usr/local/apache2/conf/mime.types
set apacheMagicFilePath /usr/local/apache2/conf/magic
set apacheIconDirectoryPath /usr/local/apache2/icons
set apachePath /usr/local/apache2/bin/httpd
set htpasswdPath /usr/local/apache2/bin/htpasswd ;# ?
set linuxDistribution {Slackware 8}
} elseif {[file isdirectory /srv/www/icons]} {
# SuSE 8.2 distribution (lac)
set apacheMimeTypesFilePath /etc/mime.types
set apacheMagicFilePath /etc/httpd/magic
set apacheIconDirectoryPath /srv/www/icons
set apachePath /usr/sbin/httpd
# set apacheLibDirectoryPath /usr/httpd/modules
set apacheLibDirectoryPath /usr/lib/apache
set htpasswdPath /usr/bin/htpasswd
set linuxDistribution {SuSE 8.2}
} elseif {[file isdirectory /usr/share/apache2/icons]} {
# SuSE 9.3 distribution (matrix.lac.inpe.br)
set apacheMimeTypesFilePath /etc/apache2/mime.types
set apacheMagicFilePath /etc/apache2/magic ;# not used to create httpd.conf
set apacheIconDirectoryPath /usr/share/apache2/icons
set apachePath /usr/sbin/httpd2
set apacheLibDirectoryPath /usr/lib/apache2 ;# not used to create httpd.conf
set htpasswdPath /usr/sbin/htpasswd2
set linuxDistribution {SuSE 9.3}
} elseif {[file isdirectory /usr/share/apache/icons]} {
# Kurumin 4.1 (based on Knoppix (based on Debian))
set apacheMimeTypesFilePath /etc/mime.types
set apacheMagicFilePath /etc/magic
set apacheIconDirectoryPath /usr/share/apache/icons
set apachePath /usr/sbin/apache
set apacheLibDirectoryPath /usr/lib/apache/1.3
set htpasswdPath /usr/bin/htpasswd
set linuxDistribution {Kurumin 4.1}
} else {
# not found
set linuxDistribution {}
}
# Linux - end
} elseif {$tcl_platform(os) == "FreeBSD"} {
# FreeBSD
# set apacheConfDirectoryPath /usr/local/etc/apache
set apacheMimeTypesFilePath /usr/local/etc/apache/mime.types
set apacheMagicFilePath /usr/local/etc/apache/magic
set apacheIconDirectoryPath /usr/local/www/icons
set apachePath /usr/local/sbin/httpd
set apacheLibDirectoryPath /usr/local/libexec/apache
set htpasswdPath /usr/local/bin/htpasswd
# set tclPath /usr/local/bin/tclsh
# set wishPath /usr/local/bin/wish
# set tclRepository {}
# set pythonRepository {}
## set unZipPath /usr/local/bin/unzip ;# see ExtractURLibService
# set unZipRepository {}
# set zipPath /usr/local/bin/zip ;# now in knownPathArray
# set zipRepository {}
# FreeBSD - end
}
}
# Unix - end
} ;# end old code
global knownRepositoryArray
# source knownRepositoryArray.tcl ;# needed by SetRepository
source $homePath/col/$URLibServiceRepository/doc/knownRepositoryArray.tcl ;# needed by SetRepository
set tclRepository [SetRepository tcl #0]
set unZipRepository [SetRepository unzip #0] ;# needed by start
if 0 { ;# added by GJFB in 2018-10-17
# old code
if {![info exists apacheMimeTypesFilePath] || ![file exists $apacheMimeTypesFilePath]} {
if [file exists $homePath/col/$URLibServiceRepository/auxdoc/apacheMimeTypesFile.txt] {
Load $homePath/col/$URLibServiceRepository/auxdoc/apacheMimeTypesFile.txt apacheMimeTypesFilePath
}
}
if {![info exists apacheMagicFilePath] || ![file exists $apacheMagicFilePath]} {
if [file exists $homePath/col/$URLibServiceRepository/auxdoc/apacheMagicFile.txt] {
Load $homePath/col/$URLibServiceRepository/auxdoc/apacheMagicFile.txt apacheMagicFilePath
}
}
if {![info exists apacheIconDirectoryPath] || ![file exists $apacheIconDirectoryPath]} {
if [file exists $homePath/col/$URLibServiceRepository/auxdoc/apacheIconDirectory.txt] {
Load $homePath/col/$URLibServiceRepository/auxdoc/apacheIconDirectory.txt apacheIconDirectoryPath
}
}
if {![info exists apachePath] || ![file exists $apachePath]} {
if [file exists $homePath/col/$URLibServiceRepository/auxdoc/apache.txt] {
Load $homePath/col/$URLibServiceRepository/auxdoc/apache.txt apachePath
}
}
if {![info exists apacheLibDirectoryPath] || ![file exists $apacheLibDirectoryPath]} {
if [file exists $homePath/col/$URLibServiceRepository/auxdoc/apacheLibDirectory.txt] {
Load $homePath/col/$URLibServiceRepository/auxdoc/apacheLibDirectory.txt apacheLibDirectoryPath
}
}
set exit 0
if ![file exists $apacheMimeTypesFilePath] {
set log "LoadGlobalVariables:\nfile not found: $apacheMimeTypesFilePath\n"
Store log $homePath/@errorLog auto 0 a
puts $log
set exit 1
}
if ![file exists $apacheMagicFilePath] {
set log "LoadGlobalVariables:\nfile not found: $apacheMagicFilePath\n"
Store log $homePath/@errorLog auto 0 a
puts $log
set exit 1
}
if ![file exists $apacheIconDirectoryPath] {
set log "LoadGlobalVariables:\nfile not found: $apacheIconDirectoryPath\n"
Store log $homePath/@errorLog auto 0 a
puts $log
set exit 1
}
if ![file exists $apachePath] {
set log "LoadGlobalVariables:\nfile not found: $apachePath\n"
Store log $homePath/@errorLog auto 0 a
puts $log
set exit 1
}
if {[string compare {} $apacheLibDirectoryPath] != 0 && \
![file exists $apacheLibDirectoryPath]} {
set log "LoadGlobalVariables:\nfile not found: $apacheLibDirectoryPath\n"
Store log $homePath/@errorLog auto 0 a
puts $log
set exit 1
}
# htpasswdPath
if {![info exists htpasswdPath] || ![file exists $htpasswdPath]} {
if [file exists $homePath/col/$URLibServiceRepository/auxdoc/htpasswd.txt] {
Load $homePath/col/$URLibServiceRepository/auxdoc/htpasswd.txt htpasswdPath
}
}
if ![file exists $htpasswdPath] {
set log "LoadGlobalVariables:\nfile not found: $htpasswdPath\n"
Store log $homePath/@errorLog auto 0 a
puts $log
set exit 1
}
if $exit {exit}
} ;# end if 0
## zipPath
if [file isdirectory $homePath/col/$zipRepository/doc] {
# set zipPath $homePath/col/$zipRepository/doc/$zipExec ;# must be homePath - now in knownPathArray
if {$tcl_platform(os) == "SunOS"} {
# if ![file executable $homePath/col/$zipRepository/doc/$zipExec] # doesn't work
if [file owned $homePath/col/$zipRepository/doc/$zipExec] {
exec chmod 774 $homePath/col/$zipRepository/doc/$zipExec
}
# #
}
}
global fieldNameArray
# fieldNameArray (used in UpdateRepositoryProperties and UpdateField)
# fieldName fileName indexName (index in repositoryProperties)
set fieldNameArray(contenttype) {contenttype type type}
set fieldNameArray(copyright) {copyright copyright copyright}
set fieldNameArray(authorhomepage) {authorhomepage authorHomePage authorhomepage}
set fieldNameArray(docpermission) {docpermission docPermission docpermission}
set fieldNameArray(downloadpermission) {downloadpermission downloadPermission downloadpermission}
set fieldNameArray(mirrorsites) {mirrorsites mirrorSites mirrorsites}
set fieldNameArray(docremotepermission) {docremotepermission docRemotePermission docremotepermission}
set fieldNameArray(downloadremotepermission) {downloadremotepermission downloadRemotePermission downloadremotepermission}
set fieldNameArray(hostcollection) {hostcollection hostCollection hostcollection}
# set fieldNameArray(copyholder) {copyholder copyHolder copyholder}
set fieldNameArray(language) {language language language}
set fieldNameArray(lastupdate) {lastupdate history history}
set fieldNameArray(size) {size size size}
set fieldNameArray(numberoffiles) {numberoffiles numberOfFiles numberoffiles}
set fieldNameArray(targetfile) {targetfile targetFile targetfile}
# set fieldNameArray(e-mailaddress) {e-mailaddress e-mailAddress e-mailaddress}
# set fieldNameArray(cgiscriptname) {cgiscriptname cgiScriptName cgiscriptname}
set fieldNameArray(cgiscriptnamelist) {cgiscriptnamelist cgiScriptNameList cgiscriptnamelist}
set fieldNameArray(authenticatedusers) {authenticatedusers authenticatedUsers authenticatedusers}
set fieldNameArray(username) {username userName username}
# set fieldNameArray(documentstage) {documentstage documentStage documentstage}
if [file exists $homePath/col/$compileWordsRepository] {
lappend auto_path $homePath/col/$compileWordsRepository/doc
package require $compileWordsRepository
}
if [file exists $homePath/col/$citationKeyRepository] {
lappend auto_path $homePath/col/$citationKeyRepository/doc
package require $citationKeyRepository
# source $homePath/col/$citationKeyRepository/doc/createKey.tcl
}
if [file exists $homePath/col/$searchRepository] {
lappend auto_path $homePath/col/$searchRepository/doc
package require $searchRepository
# source $homePath/col/$searchRepository/doc/Search.tcl
}
if [file exists $homePath/col/$inflectionRepository] {
lappend auto_path $homePath/col/$inflectionRepository/doc
package require $inflectionRepository
}
if [file exists $homePath/col/$isis2referRepository] {
lappend auto_path $homePath/col/$isis2referRepository/doc
package require $isis2referRepository
}
if [file exists $homePath/col/$parsingRepository] {
lappend auto_path $homePath/col/$parsingRepository/doc
package require $parsingRepository
# if {[string compare {} [info procs $parsingRepository::ParseFullName]] == 0} #
# source $homePath/col/$parsingRepository/doc/Parsing.tcl
# #
# puts [expr [string compare {} [info procs $parsingRepository::ParseFullName]] == 0]
}
if [file exists $homePath/col/$samplingRepository] {
lappend auto_path $homePath/col/$samplingRepository/doc
package require $samplingRepository
}
if [file isdirectory $homePath/col/iconet.com.br/banon/2003/04.18.13.10] {
global BibINPERepository
set BibINPERepository iconet.com.br/banon/2003/04.18.13.10
lappend auto_path $homePath/col/$BibINPERepository/doc
package require $BibINPERepository
}
if [file exists $homePath/col/$bib2referRepository] {
lappend auto_path $homePath/col/$bib2referRepository/doc
package require $bib2referRepository
}
# if [file exists $homePath/col/$isis2referRepository] {
# lappend auto_path $homePath/col/$isis2referRepository/doc
# package require $isis2referRepository
# }
if [file exists $homePath/col/$bibpessoal2referRepository] {
lappend auto_path $homePath/col/$bibpessoal2referRepository/doc
package require $bibpessoal2referRepository
}
# Load bib.Tables.tcl from bib2referRepository
if [file exists $homePath/col/$bib2referRepository/doc/bibTables.tcl] {
source $homePath/col/$bib2referRepository/doc/bibTables.tcl
}
# Load bib.Tables.tcl from bib2referRepository - end
# Load bib.Tables.tcl from bibpessoal2referRepository
if [file exists $homePath/col/$bibpessoal2referRepository/doc/bibTables.tcl] {
source $homePath/col/$bibpessoal2referRepository/doc/bibTables.tcl
}
# Load bib.Tables.tcl from bibpessoal2referRepository - end
# environmentArray
global environmentArray
if 0 {
if [file exists $homePath/col/$URLibServiceRepository/auxdoc/.environmentArray.tcl] {
catch {source $homePath/col/$URLibServiceRepository/auxdoc/.environmentArray.tcl}
}
if ![info exists environmentArray(localCollectionIndexRepository)] {
# try .environmentArray2.tcl
if [file exists $homePath/col/$URLibServiceRepository/auxdoc/.environmentArray2.tcl] {
catch {source $homePath/col/$URLibServiceRepository/auxdoc/.environmentArray2.tcl}
}
}
}
if {[file exists $homePath/col/$URLibServiceRepository/auxdoc/.environmentArray.tcl] || \
[file exists $homePath/col/$URLibServiceRepository/auxdoc/.environmentArrayBackup.tcl]} {
SourceWithBackup $homePath/col/$URLibServiceRepository/auxdoc/.environmentArray.tcl environmentArray ;# added by GJFB in 2010-08-05
}
# puts $environmentArray(ipAddress)
if [string equal {} $portEntry] {
if ![info exists environmentArray(spPortEntry)] {
set environmentArray(spPortEntry) 1905
}
if ![info exists environmentArray(spPortList)] {
set environmentArray(spPortList) 1905
}
} else {
# added by GJFB for Arquive migration between computers (for example)
set environmentArray(spPortEntry) $portEntry
lappend environmentArray(spPortList) $portEntry
}
# loCoInRep
global loCoInRep
# loCoInId
global loCoInId ;# used in GetURLPropertyList and CreateConfigurationFiles only
# ibiToArchiveServiceArray
global ibiToArchiveServiceArray ;# updated in UpdateIBIToArchiveServiceArray - used in GetOptimizedListOfSites only
if [info exists environmentArray(localCollectionIndexRepository)] {
set loCoInRep $environmentArray(localCollectionIndexRepository)
Store loCoInRep $homePath/@loCoInRep
Load $homePath/col/$loCoInRep/doc/@sitesHavingReadPermission.txt fileContent
set environmentArray(sitesHavingReadPermission) [split $fileContent \n]
Load $homePath/col/$loCoInRep/doc/@sitesHavingWritePermission.txt fileContent
set environmentArray(sitesHavingWritePermission) [split $fileContent \n]
LoadService $loCoInRep identifier loCoInId 1 1
if [file exists $homePath/col/$loCoInRep/auxdoc/ibiToArchiveServiceArray.tcl] {
SourceWithBackup $homePath/col/$loCoInRep/auxdoc/ibiToArchiveServiceArray.tcl ibiToArchiveServiceArray 1 ;# array set ibiToArchiveServiceArray
}
}
# loBiMiRep
global loBiMiRep
if [info exists environmentArray(localBibliographicMirrorRepository)] {
set loBiMiRep $environmentArray(localBibliographicMirrorRepository)
Store loBiMiRep $homePath/@loBiMiRep
}
# loBiMiMetadataRep
global loBiMiMetadataRep
if [info exists environmentArray(localBibliographicMirrorMetadataRepository)] {
set loBiMiMetadataRep $environmentArray(localBibliographicMirrorMetadataRepository) ;# used in MakeRepository
}
# Load ${referRepository}::orderingTable and ${referRepository}::conversionTable for Refer format
if [file exists $homePath/col/$referRepository/doc/referTables.tcl] {
source $homePath/col/$referRepository/doc/referTables.tcl
}
# global ${referRepository}::conversionTable
# Load ${referRepository}::orderingTable and ${referRepository}::conversionTable for Refer format - end
set languageRepository $englishMirrorRepository
source $homePath/col/$englishMirrorRepository/doc/mirror/enSearchResult.tcl
set languageRepository $portugueseBrasilMirrorRepository
source $homePath/col/$portugueseBrasilMirrorRepository/doc/mirror/pt-BRSearchResult.tcl
# Load BibINPEStyleSheet
if [file exists $homePath/col/$BibINPERepository/doc/BibINPEStyleSheet.tcl] {
source $homePath/col/$BibINPERepository/doc/BibINPEStyleSheet.tcl
}
# global ${BibINPERepository}::BibINPEStyleSheet
# Load BibINPEStyleSheet - end
# Create inverseTable
global inverseTable
array set inverseTable [CreateInverseTable]
# Create inverseTable - end
# Create referenceTypeList
global referenceTypeList
set referenceTypeList [CreateReferenceTypeList]
# Create referenceTypeList - end
set tclPath [SetPath tclsh #0]
set wishPath [SetPath wish #0]
set zipPath [SetPath zip #0]
set unZipPath [SetPath unzip #0]
set unRarPath [SetPath unrar #0]
set pythonPath [SetPath python #0]
if [info exists applicationName] {
if [string equal {start} $applicationName] {
# editorPath
global editorPath
set editorPath [SetPath textEditor] ;# needs knownPathArray
if [string equal {} $editorPath] {Load $homePath/col/$URLibServiceRepository/auxdoc/editor.txt editorPath}
if {$tcl_platform(platform) == "windows"} {
# mswordEditorPath
# used in XXRepository
global mswordEditorPath
set mswordEditorPath [SetPath mswordEditor] ;# needs knownPathArray
if [string equal {} $editorPath] {Load $homePath/col/$URLibServiceRepository/auxdoc/mswordEditor.txt mswordEditorPath}
}
}
}
# Create fieldNameList
global fieldNameList
if [file exists $homePath/col/$englishMirrorRepository/doc/mirror/enFieldName.tcl] {
# field::conversionTable
source $homePath/col/$englishMirrorRepository/doc/mirror/enFieldName.tcl
set fieldNameList [array names field::conversionTable]
}
# Create fieldNameList - end
# maximumNumberOfEntries
# used by RemoveMetadata and by CreateRepArray (to compute mostRecentReferences and mostRecentFullTexts)
global maximumNumberOfEntries
set maximumNumberOfEntries 10
if [info exists environmentArray(localCollectionIndexRepository)] { ;# added by GJFB in 2016-04-28
set installInitialCollection 0
} else {
set installInitialCollection 1
}
if $installInitialCollection {
set serverAddress {} ;# added by GJFB in 2016-04-28 - environmentArray is incomplete at installation and GetServerAddress cannot be run
set serverAddressWithIP {} ;# added by GJFB in 2016-04-28
} else {
set serverAddress [GetServerAddress] ;# banon-pc2.dpi.inpe.br 800
set serverAddressWithIP [GetServerAddress 1]
}
set urlibServerAddress [GetURLibServerAddress 0] ;# www.urlib.net 800
set urlibServerAddressWithIP [GetURLibServerAddress] ;# 150.163.34.64 800
set standaloneModeFlag [string equal {{} 800} $urlibServerAddressWithIP] ;# 1 iff in standalone mode
return
}
# LoadGlobalVariables - end
# ----------------------------------------------------------------------
# ReturnLoBiMiRep
# used in Get only
proc ReturnLoBiMiRep {} {
global loBiMiRep
return $loBiMiRep
}
# ReturnLoBiMiRep - end
# ----------------------------------------------------------------------
# CreateReferenceTypeList
proc CreateReferenceTypeList {} {
global referRepository
global ${referRepository}::conversionTable
set referenceTypeList {}
foreach referenceType \
[array names conversionTable *,%0] {
regsub {,%0} $referenceType {} referenceType
lappend referenceTypeList $referenceType
}
return $referenceTypeList
}
# CreateReferenceTypeList - end
# ----------------------------------------------------------------------
# CreateInverseTable
# example of conversionTable pair:
# set {conversionTable(Journal Article,%A)} author
# example of inverseTable pair:
# set {inverseTable(Journal Article,author)} %A
# set {inverseTable(Journal Article,firstauthor)} %A
proc CreateInverseTable {} {
global referRepository
global ${referRepository}::conversionTable
# global multipleLineReferFieldNamePattern
global multipleLineReferFieldNamePattern2
foreach index [array names conversionTable *,%*] {
set fieldName $conversionTable($index) ;# author
if {$fieldName == ""} {continue}
regexp {(.*),(%.*)} $index m type referFieldName ;# {Journal Article} %A
set inverseTable($type,$fieldName) $referFieldName
# if [regexp {%A|%E|%Y|%\?|%@group|%@affiliation|%@electronicmailaddress} $referFieldName]
# if [regexp $multipleLineReferFieldNamePattern $referFieldName] # ;# commented by GJFB in 2018-01-07
if [regexp $multipleLineReferFieldNamePattern2 $referFieldName] { ;# added by GJFB in 2018-01-07 to exclude nexthigerunit and previous lowerunit
# add FIRST for multiple line fields
set inverseTable($type,first$fieldName) $referFieldName
}
}
return [array get inverseTable]
}
# CreateInverseTable - end
# ----------------------------------------------------------------------
# MakeCgiScript
# example:
# docRep is the repository containing the tcl script
# auxdocRep is the repository containing the cgi script
# cgiScriptName == test.cgi
# procFileName == test.tcl
# procName == Test
# directoryName is cgi or cgi2 (cgi2 is used to host the update script) - cgi2 was introduced to avoid name conflic with repository containing cgi script
# store value is 0 or 1, 1 means to store the cgi script
# 0 is used in post to test if the cgi scripts must be changed
proc MakeCgiScript {docRep auxdocRep cgiScriptName procFileName procName {directoryName cgi} {store 1}} {
# runs with start and post
# global tclRepository
global tclPath
global pythonPath
# global col
global homePath
global tcl_platform
global URLibServiceRepository
if $store {file mkdir $homePath/col/$auxdocRep/auxdoc/$directoryName}
if {$tcl_platform(platform) == "windows"} {
if [regexp -nocase {tcl$} $procFileName] {
# tcl script
# if [file isdirectory $homePath/col/iconet.com.br/banon/2005/10.07.22.52] #
## Apache 2.0.54
set script "#!\"$tclPath\"
source \"$homePath/col/$docRep/doc/cgi/$procFileName\"
source \"$homePath/col/$URLibServiceRepository/auxdoc/.envArray.tcl\"
if \$env(ERROR_TRACE) {
if \[info exists env(PATH_INFO)\] {
set pathInfo \$env(PATH_INFO)
} else {
set pathInfo /
}
set pid \[pid\]
set clicks \[clock clicks\]
# set log \"\\\[\[clock format \[clock seconds\] -format %Y:%m.%d.%H.%M.%S\]\\\] \[pid\] $procName\"
set log \"\\\[\[clock format \[clock seconds\] -format %Y:%m.%d.%H.%M.%S\]\\\] $procName (\$pid - \$clicks):\\nclient at \$env(REMOTE_ADDR) is asking to execute the cgi script with the path info:\\n\$pathInfo\\nand with the query string:\\n\\\"\$env(QUERY_STRING)\\\"\\n\"
# set fileId \[open \"$homePath/@cgiLog\" a\]
# puts \$fileId \$log
# close \$fileId
set fileId \[open \"$homePath/@errorLog\" a\]
puts \$fileId \$log
close \$fileId
set fileId \[open \"$homePath/@cgiLog\$clicks-\$pid\" a\]
puts \$fileId \$log
close \$fileId
}
set applicationNameForReverseEngineering [lindex $procName 0] ;# for reverse engineering only
set applicationRuningTime \[clock format \[clock seconds\] -format %Y:%m.%d.%H.%M.%S\] ;# for reverse engineering only
set applicationFileName \"'$homePath/col/$docRep/doc/cgi/$procFileName'\" ;# for reverse engineering only
$procName
if \$env(ERROR_TRACE) {
file delete \"$homePath/@cgiLog\$clicks-\$pid\"
}"
} elseif [regexp -nocase {(.*)\.py$} $procFileName m procFileName] {
# python script
set script "#!\"$pythonPath\"
import sys
sys.path.append('$homePath/col/$docRep/doc/cgi')
import $procFileName"
# $procFileName.${procName}()"
} else {
# make nothing
return
}
if $store {Store script $homePath/col/$auxdocRep/auxdoc/$directoryName/$cgiScriptName}
}
if {$tcl_platform(platform) == "unix"} {
if [regexp -nocase {tcl$} $procFileName] {
# tcl script
set script "#!/bin/sh
# \\
exec $tclPath \"\$0\" \${1+\"\$@\"}
source \"$homePath/col/$docRep/doc/cgi/$procFileName\"
source \"$homePath/col/$URLibServiceRepository/auxdoc/.envArray.tcl\"
if \$env(ERROR_TRACE) {
if \[info exists env(PATH_INFO)\] {
set pathInfo \$env(PATH_INFO)
} else {
set pathInfo /
}
set pid \[pid\]
set clicks \[clock clicks\]
# set log \"\\\[\[clock format \[clock seconds\] -format %Y:%m.%d.%H.%M.%S\]\\\] \[pid\] $procName\"
set log \"\\\[\[clock format \[clock seconds\] -format %Y:%m.%d.%H.%M.%S\]\\\] $procName (\$pid - \$clicks):\\nclient at \$env(REMOTE_ADDR) is asking to execute the cgi script with the path info:\\n\$pathInfo\\nand with the query string:\\n\\\"\$env(QUERY_STRING)\\\"\\n\"
# set fileId \[open \"$homePath/@cgiLog\" a\]
# puts \$fileId \$log
# close \$fileId
set fileId \[open \"$homePath/@errorLog\" a\]
puts \$fileId \$log
close \$fileId
set fileId \[open \"$homePath/@cgiLog\$clicks-\$pid\" a\]
puts \$fileId \$log
close \$fileId
}
set applicationNameForReverseEngineering [lindex $procName 0] ;# for reverse engineering only
set applicationRuningTime \[clock format \[clock seconds\] -format %Y:%m.%d.%H.%M.%S\] ;# for reverse engineering only
set applicationFileName \"'$homePath/col/$docRep/doc/cgi/$procFileName'\" ;# for reverse engineering only
$procName
if \$env(ERROR_TRACE) {
file delete \"$homePath/@cgiLog\$clicks-\$pid\"
}"
} elseif [regexp -nocase {(.*)\.py$} $procFileName m procFileName] {
# python script
# #!\"$pythonPath\" doesn't work in Unix
set script "#!$pythonPath
import sys
sys.path.append('$homePath/col/$docRep/doc/cgi')
import $procFileName"
# $procFileName.${procName}()"
} else {
# make nothing
return
}
if $store {
Store script $homePath/col/$auxdocRep/auxdoc/$directoryName/$cgiScriptName
# exec chmod -f +x $homePath/col/$auxdocRep/auxdoc/$directoryName/$cgiScriptName
# exec chmod +x $homePath/col/$auxdocRep/auxdoc/$directoryName/$cgiScriptName
# exec chmod 755 $homePath/col/$auxdocRep/auxdoc/$directoryName/$cgiScriptName
if [file owned $homePath/col/$auxdocRep/auxdoc/$directoryName/$cgiScriptName] {exec chmod 775 $homePath/col/$auxdocRep/auxdoc/$directoryName/$cgiScriptName}
}
}
return $script
}
# MakeCgiScript - end
# ----------------------------------------------------------------------
# MakeCgiScript2
# makes update cgi
# Secure version of MakeCgiScript
# used only by SetAdvancedUserFromUserGroup
# and by a cgi script to set an advanced user name in a set of repositories
# (see dpi.inpe.br/banon-pc@1905/2005/02.19.00.40)
# password must be coded
proc MakeCgiScript2 {rep userName password} {
# runs with post
global environmentArray
global URLibServiceRepository
if ![string equal administrator $userName] {
regsub {@.*$} $environmentArray(spMailEntry) {} administratorUserName
if [string equal $administratorUserName $userName] {
# $userName is the administrator
} else {
# $userName is not the administrator
return "MakeCgiScript2: $userName is not the administrator"
}
}
if [CheckPassword $userName $password] {
return "MakeCgiScript2: the password is incorrect or the user name doesn't exist"
}
# MakeCgiScript $URLibServiceRepository $rep update update.tcl Update cgi2
MakeCgiScript $URLibServiceRepository $rep update mirror.tcl {CreateMirror 1} cgi2
return ;# needed, otherwise the first line of $script returned by MakeCgiScript is returned by MakeCgiScript2 (this is a problem for Script in dpi.inpe.br/banon-pc@1905/2005/02.19.00.40)
}
# MakeCgiScript2 - end
# ----------------------------------------------------------------------
# MakeAllCgiScripts
# cgiScriptName procFileName procName
# wholeCollection value is 0 or 1; 1 means to make the cgi scripts for the whole collection
proc MakeAllCgiScripts {{wholeCollection 0}} {
global URLibServiceRepository
global repositoryList
global homePath
global pwd
global repositoryProperties
global OAIProtocolRepository ;# parent repository for the URLibService
global administratorPageRepository ;# parent repository for the URLibService
# proc MakeCgiScript {docRep auxdocRep cgiScriptName procFileName procName {directoryName cgi} {store 1}}
set rep $URLibServiceRepository
# to add a new cgi script update this procedure
# see also ScriptAlias in CreateConfigurationFiles (in StartServer.tcl)
# set updateLevel(3) with a new date (update date) in $homePath/newVersion
# for the developing collection just delete auxdoc/cgi/get and do unpost/post
MakeCgiScript $rep $rep get- get-.tcl Get-
MakeCgiScript $rep $rep get get.tcl Get
# MakeCgiScript $rep $rep getibiproperties getibiproperties.tcl GetIBIProperties ;# added by GJFB in 2012-06-03 - used in IBI resolution - obsolete, now Script in col/urlib.net/www/2014/03.16.03.40/cgi/script.tcl
MakeCgiScript $rep $rep getprogress getprogress.tcl GetProgress ;# added by GJFB in 2013-09-15 - used in Get
MakeCgiScript $rep $rep cover cover.tcl Cover
MakeCgiScript $rep $rep from from.tcl From
MakeCgiScript $rep $rep mirror.cgi mirror.tcl CreateMirror
MakeCgiScript $rep $rep metadata.cgi metadata.tcl CreateMetadata
MakeCgiScript $rep $rep mirrorsearch.cgi mirrorsearch.tcl MirrorSearch
MakeCgiScript $rep $rep mirrorget.cgi mirrorget.tcl MirrorGet
MakeCgiScript $rep $rep mirrorfind-.cgi mirrorfind-.tcl Find-
# MakeCgiScript $rep $rep mirrorfind2-.cgi mirrorfind2-.tcl Find2-
MakeCgiScript $rep $rep checkchange.cgi checkchange.tcl CheckChange
MakeCgiScript $rep $rep copyright.cgi copyright.tcl Copyright
MakeCgiScript $rep $rep statistics.cgi statistics.tcl Statistics
MakeCgiScript $rep $rep download.cgi download.tcl Download
MakeCgiScript $rep $rep archive.cgi archive.tcl Archive
MakeCgiScript $rep $rep attachment.cgi attachment.tcl Attachment ;# added by GJFB in 2014-08-19 - used in CreateDirectoryContentList (called by DisplayDocContent (option GetFileList))
MakeCgiScript $rep $rep export.cgi export.tcl Export
MakeCgiScript $rep $rep advertising.cgi advertising.tcl CreateAdvertisingWarning
MakeCgiScript $rep $rep submit.cgi submit.tcl Submit
MakeCgiScript $rep $rep confirm.cgi confirm.tcl Confirm
# MakeCgiScript $rep $rep update update.tcl Update
# MakeCgiScript $rep $rep review review.tcl Review
MakeCgiScript $rep $rep createpage.cgi createpage.tcl CreatePage
MakeCgiScript $rep $rep createindex.cgi createindex.tcl CreateIndex
MakeCgiScript $rep $rep search.cgi search.tcl Search
MakeCgiScript $rep $rep register.cgi register.tcl Register
MakeCgiScript $rep $rep processreview.cgi processreview.tcl ProcessReview
MakeCgiScript $rep $rep forcenewpassword.cgi forcenewpassword.tcl ForcePassword cgi2
MakeCgiScript $rep $rep info info.tcl Info
MakeCgiScript $rep $rep test2 test2.tcl TestExecute
MakeCgiScript $rep $rep getenv getenv.tcl GetEnv
MakeCgiScript $rep $rep displaydoccontent.cgi displaydoccontent.tcl DisplayDocContent
if $wholeCollection {
CreateRepositoryList
foreach rep $repositoryList {
# if [info exists repositoryProperties($rep,username)] # ;# commented by GJFB in 2016-01-19 - cgi2/update is not deleted when turning the username empty, therefore when returning to any username after a migration cgi2/update might be out of date
if [file exists $homePath/col/$rep/auxdoc/cgi2/update] {
MakeCgiScript $URLibServiceRepository $rep update mirror.tcl {CreateMirror 1} cgi2
}
# if [TestContentType $rep {^CGI Script$|^Submission Form$}] #
if [TestContentType $rep {^CGI Script$}] {
InstallCGIScript $rep
}
# migration 2007-10-16
# cgi2 -> cgi3
if [file exists $homePath/col/$rep/auxdoc/cgi2/review] {
MakeCgiScript $URLibServiceRepository $rep review review.tcl Review cgi3
file delete $homePath/col/$rep/auxdoc/cgi2/review
}
# migration 2007-10-16 - end
if [file exists $homePath/col/$rep/auxdoc/cgi3/review] {
MakeCgiScript $URLibServiceRepository $rep review review.tcl Review cgi3
}
}
} else {
set rep $OAIProtocolRepository
MakeCgiScript $rep $rep oai.cgi oai.tcl oai
set rep $administratorPageRepository
MakeCgiScript $rep $rep script.cgi script.tcl Script
}
}
# CreateConfigurationFiles must also be edited
# (when adding a new cgi script in URLibServiceRepository)
# MakeAllCgiScripts - end
# ----------------------------------------------------------------------
# InstallCGIScript
# installs the scripts (tcl and python) stored in doc/cgi
# installation occurs when the content type option {Cgi Script}
# is selected
proc InstallCGIScript {rep} {
# runs with post
global col
global pwd
global repositoryProperties
global startApacheServer
if ![file isdirectory $col/$rep/doc/cgi] {return}
cd $col/$rep/doc/cgi
set procFileNameList [glob -nocomplain {*.[tT][cC][lL]}] ;# ex: test.tcl
set procFileNameList [concat $procFileNameList [glob -nocomplain {*.[pP][yY]}]] ;# ex: test.py
cd $pwd
if [info exists repositoryProperties($rep,cgiscriptnamelist)] {
set oldCGIScriptNameList $repositoryProperties($rep,cgiscriptnamelist)
} else {
set oldCGIScriptNameList {}
}
set startApacheServer 0
set cgiScriptNameList {}
foreach procFileName $procFileNameList {
# test.tcl -> test.cgi
if ![regsub -nocase {tcl$|py$} $procFileName {cgi} cgiScriptName] {
# nothing to install
continue
}
if {[set i [lsearch -exact $oldCGIScriptNameList $cgiScriptName]] == -1} {
# the script is a new one
set startApacheServer 1
} else {
set oldCGIScriptNameList [lreplace $oldCGIScriptNameList $i $i]
}
Load $col/$rep/doc/cgi/$procFileName fileContent ;# ex: load test.tcl
if [regexp -nocase {tcl$} $procFileName] {
# tcl script
if ![regexp "\nproc +(\[^ \]*)" $fileContent m procName] {continue}
} elseif [regexp -nocase {py$} $procFileName] {
# python script
# if ![regexp "^def +(\[^\(\]*)" $fileContent m procName] {
# regexp "\ndef +(\[^\(\]*)" $fileContent m procName
# }
set procName {}
} else {
# nothing to install
continue
}
# set xxx [list $rep $cgiScriptName $procFileName $procName]
# set xxx [list $rep]
# Store xxx C:/tmp/bbb auto 0 a
MakeCgiScript $rep $rep $cgiScriptName $procFileName $procName
lappend cgiScriptNameList $cgiScriptName
}
if ![string equal {} $oldCGIScriptNameList] {
# some old scripts are not used anymore
set startApacheServer 1
}
if ![string equal {} $cgiScriptNameList] {
set repositoryProperties($rep,cgiscriptnamelist) $cgiScriptNameList
StoreService cgiScriptNameList $rep cgiScriptNameList 0 1
}
}
# InstallCGIScript - end
# ----------------------------------------------------------------------
# CreateCommonWordsRepList
proc CreateCommonWordsRepList {} {
# runs with post
global referenceTable
global repositoryProperties
global compileWordsRepository
set commonWordsRepList {}
foreach index [array names referenceTable *,$compileWordsRepository] {
regsub {,.*} $index {} rep
if {[info exists repositoryProperties($rep,targetfile)] && \
[regexp {Words.tcl} \
$repositoryProperties($rep,targetfile)]} {
lappend commonWordsRepList $rep
}
}
return $commonWordsRepList
}
# CreateCommonWordsRepList - end
# ----------------------------------------------------------------------
# ConvertMultipleRefer2MetadataList
# Examples:
# ConvertMultipleRefer2MetadataList 0 $entry $metadataRep (in CreateIdentificationKey)
# ConvertMultipleRefer2MetadataList 0 $fileContent $rep (in StartService)
# ConvertMultipleRefer2MetadataList 0 $fileContent $metadataRep (in GetMetadataRepositories)
# ConvertMultipleRefer2MetadataList 1 [${bib2referRepository}::Bib2Refer $fileContent] $rep (in LoadBiblioDB)
# ConvertMultipleRefer2MetadataList 1 $fileContent $rep (in Refer2Bib)
# ConvertMultipleRefer2MetadataList 0 $fileContent $metadataRep (in UpdateMetadataBase)
# ConvertMultipleRefer2MetadataList 0 $entry $metadataRep (in XXRepository)
# metadataRep is the name of the repository containing the bibliographic
# references (-i)
# first value is 0 or 1
# 0 is used to specified a metadata for URLibService (-0)
# (metadata contained in a @metadata.refer file)
# 1 is used to specified metadata contained in any other bibliographic
# file (e.g. @reference.bib)
# if metadataArrayName == {} return list
# otherwise place the result in metadataArray
# (this variable must be defined in the calling procedure) - used in LoadBiblioDB
proc ConvertMultipleRefer2MetadataList {first references metadataRep {metadataArrayName {}}} {
# runs with start and post
if ![string equal {} $metadataArrayName] {upvar $metadataArrayName metadataArray}
regsub -all "\n+" $references "\n" references
regsub -all {@} $references {#!#} references ;# @ > #!#
regsub -all {%0} $references {@%0} references
set i $first
foreach entry [lrange [split $references @] 1 end] {
# set x 0; after 1 {set x 1}; vwait x ;# nice procedure - commented by GJFB in 2012-10-19 otherwise if executing Get of a Journal Article with his archiving policy previously removed using the URLibService interface, then this nice procedure waits until the submission queue is cleared - the problem appears after including UpdateReadPermissionFromSecondaryDate (that calls UpdateRepMetadataRep) in GetURLPropertyList (running under post)
regsub -all {#!#} $entry {@} entry ;# #!# > @
# the two lines below have not been tested
# regsub -all "\[^-\]\n" $entry { } entry2
# regsub -all -- "-\n" $entry2 {} entry2 ;# hyphen
array set metadataArray [ConvertRefer2MetadataList $entry $metadataRep $i]
## Update citationkey
# set citationkey [CreateCitationKey metadataArray $metadataRep-$i 1]
# set metadataArray($metadataRep-$i,citationkey) $citationkey
## Update citationkey - end
incr i
}
if [string equal {} $metadataArrayName] {return [array get metadataArray]}
}
# ConvertMultipleRefer2MetadataList - end
# ----------------------------------------------------------------------
# ConvertRefer2MetadataList
# working example:
# previousFieldName fieldName previousDifferentFields differentFields store
# Loop --------------------------------------------------------------------
# 0(initial) 0 0(initial) 0
# 0 A 0 1 0
# A A 1 0 A(first)
# A A 0 0
# A T 0 1 A(all)
# T D 1 1 T
# End Loop ----------------------------------------------------------------
# D 1 D
# Loop --------------------------------------------------------------------
# 0(initial) 0 0(initial) 0
# 0 A 0 1 0
# A T 1 1 A(first and all)
# T D 1 1 T
# End Loop ----------------------------------------------------------------
# D 1 D
proc ConvertRefer2MetadataList {entry metadataRep i} {
# runs with start and post
global referRepository
global ${referRepository}::conversionTable
# global multipleLineReferFieldNamePattern
global multipleLineReferFieldNamePattern2
# Create a list of reference types
set referenceTypes {}
foreach referenceType \
[array names conversionTable *,%0] {
regsub {,%0} $referenceType {} referenceType
lappend referenceTypes $referenceType
}
# Create a list of reference types - end
set entry2 \n[string trim $entry \n]
regsub -all {@} $entry2 {#!#} entry2 ;# @ -> #!#
regsub -all "\n%(\[^ \\.;,\])" $entry2 {@\1} entry2
# regsub -all "\n" $entry2 { } entry2
regsub -all "\n+" $entry2 { } entry2
# type
set field [lindex [split $entry2 @] 1]
# we assume that 0 is the first field
if ![regexp "^0 (.*)" $field m type] {return [list $metadataRep-$i,referencetype Misc]}
if {[lsearch -exact $referenceTypes $type] == -1} {
set type Generic
}
# Ordering the refer fields
set referMetadata {}
set beginWith- 0
set index $i
foreach field [lrange [split $entry2 @] 1 end] {
# puts --$field--
# if ![regexp { } $field] {continue} ;# drop field with no value (otherwise we may get duplicate title)
regsub -all {#!#} $field {@} field ;# #!# -> @
if [regexp {^@index} $field] {set begingWith- 1}
if [regexp {^@index (.*)} $field m index] {set begingWith- 1}
lappend referMetadata %$field
}
# puts [join $referMetadata \n]
# rep-i
# set rep-i $metadataRep-$i
set rep-i $metadataRep-$index
set referMetadata [lsort -command ReferFieldCompare $referMetadata]
# Ordering the refer fields - end
if 0 {
# old code - still working
set previousFieldName 0
set previousDifferentFields 0
set fieldContent {}
# FOREACH
foreach field $referMetadata {
# Store field C:/tmp/aaa auto 0 a
if [regexp "%(\[^ \]*) +(.*)" $field m fieldName fieldValue] {
set fieldValue [string trimright $fieldValue]
} else {
# empty field
regexp {%(.*)} $field m fieldName
set fieldValue {}
}
# Add trailing comma
# usefull when data come from isis
if [regexp {A|E|Y|\?} $fieldName] {
if [regexp {,} $fieldValue] {
set fieldValue [string trimright $fieldValue ,]
set fieldValue $fieldValue, ;# add trailing comma
}
}
# Add trailing comma - end
set differentFields [expr [string compare $fieldName $previousFieldName] != 0]
if {[info exists conversionTable($type,%$previousFieldName)] && $conversionTable($type,%$previousFieldName) != {}} {
# if [regexp {A|E|Y|\?|@group|@affiliation|@electronicmailaddress} $previousFieldName]
# if [regexp $multipleLineReferFieldNamePattern $previousFieldName] # ;# commented by GJFB in 2018-01-07
if [regexp $multipleLineReferFieldNamePattern2 $previousFieldName] { ;# added by GJFB in 2018-01-07 to exclude nexthigerunit and previous lowerunit
if $previousDifferentFields {
## add FIRST for some multiple line fields
# add FIRST for multiple line fields
# store first of A, E, Y, ?, @group, @affiliation ...
set localMetadataArray(${rep-i},first$conversionTable($type,%$previousFieldName)) $fieldContent
}
}
}
if !$differentFields {
lappend fieldContent $fieldValue
} else {
if {[info exists conversionTable($type,%$previousFieldName)] && $conversionTable($type,%$previousFieldName) != {}} {
# if [regexp {A|E|Y|\?|@group|@affiliation|@electronicmailaddress} $previousFieldName]
# if [regexp $multipleLineReferFieldNamePattern $previousFieldName] # ;# commented by GJFB in 2018-01-07
if [regexp $multipleLineReferFieldNamePattern2 $previousFieldName] { ;# added by GJFB in 2018-01-07 to exclude nexthigerunit and previous lowerunit
# multiple line fields
# store all of A, E, Y, ?, @group, @affiliation, @electronicmailaddress ...
set localMetadataArray(${rep-i},$conversionTable($type,%$previousFieldName)) $fieldContent
} else {
# not A, E, Y, ?, @group, @affiliation, electronicmailaddress ...
set localMetadataArray(${rep-i},$conversionTable($type,%$previousFieldName)) [join $fieldContent]
}
}
set fieldContent [list $fieldValue]
}
set previousFieldName $fieldName
set previousDifferentFields $differentFields
}
# FOREACH - end
# process the last field
if {$conversionTable($type,%$fieldName) != {}} {
# if [regexp {A|E|Y|\?|@group|@affiliation|@electronicmailaddress} $fieldName]
# if [regexp $multipleLineReferFieldNamePattern $fieldName] # ;# commented by GJFB in 2018-01-07
if [regexp $multipleLineReferFieldNamePattern2 $fieldName] { ;# added by GJFB in 2018-01-07 to exclude nexthigerunit and previous lowerunit
# multiple line fields
if $differentFields {
# if [regexp $multipleLineReferFieldNamePattern $fieldName] # ;# commented by GJFB in 2018-01-07
if [regexp $multipleLineReferFieldNamePattern2 $fieldName] { ;# added by GJFB in 2018-01-07 to exclude nexthigerunit and previous lowerunit
## add FIRST for some multiple line fields
# add FIRST for multiple line fields
# store first of A, E, Y, ?, @group, @affiliation ...
set localMetadataArray(${rep-i},first$conversionTable($type,%$fieldName)) $fieldContent
}
}
# store all of A, E, Y, ?, @group, @affiliation, @electronicmailaddress ...
set localMetadataArray(${rep-i},$conversionTable($type,%$fieldName)) $fieldContent
} else {
# not A, E, Y, ?, @group, @affiliation, @electronicmailaddress ...
set localMetadataArray(${rep-i},$conversionTable($type,%$fieldName)) [join $fieldContent]
}
}
} else {
# new code (simpler) by GJFB in 2017-01-07
# FOREACH
foreach field $referMetadata {
# Store field C:/tmp/aaa auto 0 a
if [regexp "%(\[^ \]*) +(.*)" $field m fieldName fieldValue] {
set fieldValue [string trimright $fieldValue]
} else {
# empty field
regexp {%(.*)} $field m fieldName
set fieldValue {}
}
# Add trailing comma
# usefull when data come from isis
if [regexp {A|E|Y|\?} $fieldName] {
if [regexp {,} $fieldValue] {
set fieldValue [string trimright $fieldValue ,]
set fieldValue $fieldValue, ;# add trailing comma
}
}
# Add trailing comma - end
if {[info exists conversionTable($type,%$fieldName)] && $conversionTable($type,%$fieldName) != {}} {
set metadataFieldName $conversionTable($type,%$fieldName)
# if [regexp {A|E|Y|\?|@group|@affiliation|@electronicmailaddress} $previousFieldName]
# if [regexp $multipleLineReferFieldNamePattern $fieldName] # ;# commented by GJFB in 2018-01-07
if [regexp $multipleLineReferFieldNamePattern2 $fieldName] { ;# added by GJFB in 2018-01-07 to exclude nexthigerunit and previous lowerunit
if ![info exists localMetadataArray(${rep-i},first$metadataFieldName)] {
# add FIRST for some multiple line fields
# store first of A, E, Y, ?, @group, @affiliation ...
set localMetadataArray(${rep-i},first$metadataFieldName) [list $fieldValue]
}
lappend localMetadataArray(${rep-i},$metadataFieldName) $fieldValue
} else {
# puts --$fieldValue--
if ![info exists localMetadataArray(${rep-i},$metadataFieldName)] {
set localMetadataArray(${rep-i},$metadataFieldName) $fieldValue
} else {
append localMetadataArray(${rep-i},$metadataFieldName) " $fieldValue"
}
}
}
}
# FOREACH - end
}
# puts [array get localMetadataArray]
# Process firstgroup
# drop initial empty groups (meaningful firstgroup must not be emtpy)
if [info exists localMetadataArray(${rep-i},group)] {
foreach group $localMetadataArray(${rep-i},group) {
if ![string equal {} $group] {
set localMetadataArray(${rep-i},firstgroup) $group
break
}
}
}
# Process firstgroup - end
if !${beginWith-} {
# could be for all (if could be dropped)
set localMetadataArray(${rep-i},index) $index ;# used to display the full reference (mirror)
}
# Update citationkey
# at update, author, year and title might have changed
set citationkey [CreateCitationKey localMetadataArray $metadataRep-$index 1]
set localMetadataArray($metadataRep-$index,citationkey) $citationkey
# puts "citationkey updated in $metadataRep-$index"
# Update citationkey - end
# puts [array get localMetadataArray]
return [array get localMetadataArray]
}
if 0 {
# testing
source cgi/mirrorfind-.tcl ;# Load
source utilitiesStart.tcl
source utilities1.tcl ;# CreateWebLanguageTable
source utilitiesMirror.tcl
LoadGlobalVariables
source $homePath/col/$URLibServiceRepository/auxdoc/.repositoryProperties.tcl ;# used in CreateCommonWordsRepList
source $homePath/col/$URLibServiceRepository/auxdoc/.referenceTable.tcl ;# ;# used in CreateCommonWordsRepList
set commonWords [${compileWordsRepository}::CompileWords [CreateCommonWordsRepList]] ;# used in CreateCitationKey
# set metadataRep dpi.inpe.br/banon/1995/09.18.18.50
# set metadataRep dpi.inpe.br/banon-pc2@1905/2005/07.11.21.15.43
# set metadataRep urlib.net/www/2013/05.21.00.26.04
set metadataRep iconet.com.br/banon/2005/12.30.19.29.37
Load ../../../../../$metadataRep/doc/@metadata.refer entry
# set i 1
set i 0
set list [ConvertRefer2MetadataList $entry $metadataRep $i]
puts $list
# =>
# iconet.com.br/banon/2005/12.30.19.29.37-0,index 0 iconet.com.br/banon/2005/12.30.19.29.37-0,repository iconet.com.br/banon/2005/12.30.19.29 iconet.com.br/banon/2005/12.30.19.29.37-0,copyholder SID/SCD iconet.com.br/banon/2005/12.30.19.29.37-0,referencetype {Newspaper Article} iconet.com.br/banon/2005/12.30.19.29.37-0,documentstage {not transferred} iconet.com.br/banon/2005/12.30.19.29.37-0,firstreporter {{Ribeiro, João,}} iconet.com.br/banon/2005/12.30.19.29.37-0,reporter {{Ribeiro, João,} {Batista, Laura,}} iconet.com.br/banon/2005/12.30.19.29.37-0,citationkey RibeiroBati:2002:Te iconet.com.br/banon/2005/12.30.19.29.37-0,newspaper {O Globo} iconet.com.br/banon/2005/12.30.19.29.37-0,targetfile clipping1.html iconet.com.br/banon/2005/12.30.19.29.37-0,issuedate 2002-03-12 iconet.com.br/banon/2005/12.30.19.29.37-0,metadatarepository iconet.com.br/banon/2005/12.30.19.29.37 iconet.com.br/banon/2005/12.30.19.29.37-0,year 2002 iconet.com.br/banon/2005/12.30.19.29.37-0,title Teste2 iconet.com.br/banon/2005/12.30.19.29.37-0,type {URLibService test} iconet.com.br/banon/2005/12.30.19.29.37-0,usergroup banon iconet.com.br/banon/2005/12.30.19.29.37-0,firstusergroup banon iconet.com.br/banon/2005/12.30.19.29.37-0,nexthigherunit {J8LNKB5R7W/3GFJKM8 J8LNKB5R7W/3LBEQ3H} iconet.com.br/banon/2005/12.30.19.29.37-0,firstaffiliation {{Instituto Nacional de Pesquisas Espaciais (INPE)}} iconet.com.br/banon/2005/12.30.19.29.37-0,affiliation {{Instituto Nacional de Pesquisas Espaciais (INPE)}}
}
# ConvertRefer2MetadataList - end
# ----------------------------------------------------------------------
# SaveMetadata
# Save metadata if saveMetadata == 1
# used in StartService and others
# force value is 0 or 1; 1 means to save anyway (independently of saveFlag)
# proc SaveMetadata {{force 0} {suffix {}}}
proc SaveMetadata {{force 0}} {
# runs with post
global saveMetadata
global col
global URLibServiceRepository
global saveFlag
global repArray
global repArray2
# set xxx [CallTrace]
# Store xxx C:/tmp/bbb auto 0 a
# Store saveMetadata C:/tmp/bbb auto 0 a
# puts $saveFlag
if {($saveFlag || $force) && (![info exists saveMetadata] || $saveMetadata)} {
set auxDoc $col/$URLibServiceRepository/auxdoc
StoreArray metadataArray $auxDoc/.metadataArray.tcl w list
# if [llength [array names repArray]] {StoreArray repArray $auxDoc/.repArray.tcl w list}
if [info exists repArray] {StoreArray repArray $auxDoc/.repArray.tcl w list}
if [info exists repArray2] {StoreArray repArray2 $auxDoc/.repArray2.tcl w list}
StoreArray authorArray $auxDoc/.authorArray.tcl w list ;# authorArray created/updated in CreateRepArray
StoreArray groupArray $auxDoc/.groupArray.tcl w list ;# groupArray created/updated in CreateRepArray
StoreArray committeeArray $auxDoc/.committeeArray.tcl w list ;# committeeArray created/updated in CreateRepArray
StoreArray journalArray $auxDoc/.journalArray.tcl w list ;# journalArray created/updated in CreateRepArray
StoreArray conferencenameArray $auxDoc/.conferencenameArray.tcl w list ;# conferencenameArray created/updated in CreateRepArray
StoreArray wordOccurrenceArray $auxDoc/.wordOccurrenceArray.tcl w list
StoreArray mostRecentReferences $auxDoc/.mostRecentReferences.tcl w list
StoreArray mostRecentFullTexts $auxDoc/.mostRecentFullTexts.tcl w list
set saveMetadata 0
}
}
# SaveMetadata - end
# ----------------------------------------------------------------------
# SaveRepositoryProperties
# force value is 0 or 1; 1 means to save anyway (independently of saveFlag)
proc SaveRepositoryProperties {{force 0}} {
# runs with post
global col
global URLibServiceRepository
global saveFlag
if {$saveFlag || $force} {
set auxDoc $col/$URLibServiceRepository/auxdoc
StoreArray repositoryProperties $auxDoc/.repositoryProperties.tcl w list
}
}
# SaveRepositoryProperties - end
# ----------------------------------------------------------------------
# SaveReferenceTable
# force value is 0 or 1; 1 means to save anyway (independently of saveFlag)
proc SaveReferenceTable {{force 0}} {
# runs with post
global col
global URLibServiceRepository
global saveFlag
if {$saveFlag || $force} {
set auxDoc $col/$URLibServiceRepository/auxdoc
StoreArray referenceTable $auxDoc/.referenceTable.tcl w list
}
}
# SaveReferenceTable - end
# ----------------------------------------------------------------------
# UpdateKeyRepositoryList
# updates the key if rep exists
# if listName is keyRepositoryList adds a key-repository item without repetition
# Examples of listName values:
# keyRepositoryList (default)
# ddSelectedKeyRepList
# storeKeyRepositoryListFlag value is 0 or 1; 1 means to store the keyRepositoryList
# example of keyRepositoryList: {{BanonPess::BiFiFo dpi.inpe.br/banon/1995/08.25.00.00} {Banon:1995:CoDeFu dpi.inpe.br/banon/1995/09.01.10.50}}
proc UpdateKeyRepositoryList {rep {storeKeyRepositoryListFlag 0} {listName {keyRepositoryList}}} {
# runs with start
# global col
# global URLibServiceRepository
upvar #0 $listName list
if [string equal keyRepositoryList $listName] {
# listName is keyRepositoryList
if ![info exists list] {set list {}}
set i [lsearch -regexp $list $rep$] ;# may result in an error: couldn't compile regular expression pattern - when $rep (see content of auxdoc/.repositoryListForStart.tcl) is not a rep name (but for example a list like: {servername citationkey versionstamp metadatarep-i 1})
# example of a non rep name (at the end fo the file): {{mtc-m12.sid.inpe.br 800} {} {2013:02.08.15.28.12 sid.inpe.br/banon/2001/04.06.10.52 marciana {D 2005}} sid.inpe.br/iris@1912/2005/12.26.17.22.42-0 1 {}}
if {$i != -1} {
set oldKeyRepository [lindex $list $i]
# delete (the key may be old)
set list [lreplace $list $i $i]
} else {
set oldKeyRepository {}
}
set newKeyRepository [list [CreateIdentificationKey $rep] $rep]
lappend list $newKeyRepository
# SAVE
if {$newKeyRepository != "$oldKeyRepository"} {
# set auxDoc $col/$URLibServiceRepository/auxdoc
# StoreList $listName $auxDoc/.keyRepositoryList.tcl
set storeKeyRepositoryListFlag 1 ;# keyRepositoryList need to be stored
}
# SAVE - end
} else {
# listName is not keyRepositoryList
if ![info exists list] {return}
set i [lsearch -regexp $list $rep$]
if {$i != -1} {
# delete (the key may be old)
set list [lreplace $list $i $i]
set newKeyRepository [list [CreateIdentificationKey $rep] $rep]
lappend list $newKeyRepository
}
}
return $storeKeyRepositoryListFlag
}
# UpdateKeyRepositoryList - end
# ----------------------------------------------------------------------
# AddKey
# delete the URLib home path and add the key
# the key may exist
# the key may be missing even when reverse == 0 (key first)
# if the key is in the keyRepositoryList then it is used
# example: AddKey $repName/ 0
# uses CreateIdentificationKey
proc AddKey {string {reverse {1}}} {
# runs with start
global keyRepositoryList
regsub {^.*/col/} $string {} string
if ![regexp { } $string] {
# the key does not exist
if [regexp {[^/]*/[^/]*/[^/]*/[^/]*/$} $string] {
# repository name well formed, the key must be added
regsub {/$} $string {} rep ;# delete trailing /
# Extract key
if ![info exists keyRepositoryList] {
# keyRepositoryList may not exist, e.g. when first use DDRoutine
set keyRepositoryList {}
}
set i [lsearch -regexp $keyRepositoryList $rep$]
if {$i == -1} {
set key [CreateIdentificationKey $rep]
} else {
set key [lindex [lindex $keyRepositoryList $i] 0]
}
# Extract key - end
if $reverse {
return "$rep $key"
} else {
return "$key $rep"
}
}
}
# don't add key
return $string
}
# puts [AddKey c:/usuario/gerald/URLib/col/dpi.inpe.br/banon/1998/08.02.08.56/]
# => dpi.inpe.br/banon/1998/08.02.08.56 Banon::UR
# puts [AddKey dpi.inpe.br/banon/1998/08.02.08.56/]
# => dpi.inpe.br/banon/1998/08.02.08.56 Banon::UR
# AddKey - end
# ----------------------------------------------------------------------
# CreateIdentificationKey
# used by AddKey and UpdateKeyRepositoryList only
# Examples:
# Banon:2000:Co
# :metadata.cgi:
# the citation key is obtained from the data in the @metadataRefer file
proc CreateIdentificationKey {rep} {
# runs with start
global col
global homePath
global tcl_platform
global applicationName
if [Eval TestContentType $rep Metadata] {
# metadata have no metadata
return :metadata.cgi:
} else {
set metadataRep [Eval FindMetadataRep $rep]
if ![file isdirectory $homePath/col/$metadataRep] {
UpdateVariables $metadataRep ;# discards rep from keyRepositoryList
set metadataRep ""
}
if {$metadataRep == ""} {
return [Eval MakeTargetKey $rep]
} else {
if ![file exists $col/$metadataRep/doc/@metadata.refer] {
if {$tcl_platform(platform) == "windows" && [string equal {start} $applicationName]} {
console show
}
puts {syntax error:}
puts {the metadata file doesn't exist in} ;# '
puts "$homePath/col/$metadataRep/doc"
puts {or its name is not @metadata.refer}
puts {solution:}
puts {create a metadata file named @metadata.refer}
puts {press exit}
puts {start again URLibService}
vwait forever
}
if 1 {
# new code added by GJFB in 2012-06-16 (faster)
set citationKey [Get metadataArray($metadataRep-0,citationkey)]
} else {
# old code
Load $col/$metadataRep/doc/@metadata.refer entry
array set metadataArray [ConvertMultipleRefer2MetadataList 0 $entry $metadataRep]
set citationKey [CreateCitationKey metadataArray $metadataRep-0 1]
}
return $citationKey
}
}
}
# CreateIdentificationKey - end
# ----------------------------------------------------------------------
# CreateCitationKey
# return the citation key of a rep-i metadata
proc CreateCitationKey {metadataArrayName rep-i {level {#0}}} {
# runs with start and post
global referRepository
global ${referRepository}::conversionTable
global citationKeyRepository
global commonWords
upvar $level $metadataArrayName metadataArray
## type
# set type [ReturnType metadataArray ${rep-i} 1]
# author
set author [GetAuthor ${rep-i} 1] ;# uses metadataArray
# set author [EscapeUntrustedData $author] ;# added by GJFB in 2018-06-08 - escape untrusted data - XSS prevention
# referenceType
set referenceType $metadataArray(${rep-i},referencetype)
# year
if [string equal {Film or Broadcast} $referenceType] {
ConditionalSet year metadataArray(${rep-i},yearreleased) {}
} elseif {[string equal {Resume} $referenceType]} {
ConditionalSet dayOfBirth metadataArray(${rep-i},dayofbirth) {}
# regexp {^\d{4,}} $dayOfBirth year
regsub {^\d{4,}-(\d{2})-(\d{2})$} $dayOfBirth {\1\2} year ;# hide the year
} else {
ConditionalSet year metadataArray(${rep-i},year) {}
}
# set year [EscapeUntrustedData $year] ;# added by GJFB in 2018-06-08 - escape untrusted data - XSS prevention
# suffix
# in Medeiros:1974:Es14 14 is the suffix
set suffix {}
if [string equal {Newspaper} $referenceType] {
if [info exists metadataArray(${rep-i},number)] {
set suffix $metadataArray(${rep-i},number)
# set suffix [EscapeUntrustedData $suffix] ;# added by GJFB in 2018-06-08 - escape untrusted data - XSS prevention
if ![regexp {\d+} $suffix suffix] {set suffix {}} ;# # keep just the decimal part
}
}
# title
set title [GetFieldValue ${rep-i} title 1]
# set title [EscapeUntrustedData $title] ;# added by GJFB in 2018-06-08 - escape untrusted data - XSS prevention
return [${citationKeyRepository}::CreateKey $author $year $title $commonWords $suffix]
}
# CreateCitationKey - end
# ----------------------------------------------------------------------
# FindMetadataRep
# returns the metadata repository name of the metadata repository whose language is the one informed in the language argument
# if the language argument is empty or if there is no repository containing metadata within the required language
# then it returns the one which contains the metadata within the first/original language
# (returns the metadata repository name even though the metadata repository has been deleted)
# FindMetadataRep is case sensitive
# rep can be any repository (metadata repository or not)
# if it is a metadata repository FindMetadataRepList returns empty
proc FindMetadataRep {rep {language {}}} {
# runs with post
global repositoryProperties
global homePath
# new code by GJFB in 2012-08-18
# language defined
# puts "rep = $rep"
set metadataRepList [FindMetadataRepList $rep]
# puts "metadataRepList = --$metadataRepList--"
if [string equal {} $metadataRepList] {return} ;# metadataRep not found or rep is a metadata repository
set foundFlag 0 ;# not found
if ![string equal {} $language] {
foreach metadataRep $metadataRepList {
if [info exists repositoryProperties($metadataRep,language)] {
set metadataLanguage $repositoryProperties($metadataRep,language)
regexp {\[(.*)\]} $metadataLanguage m metadataLanguage ;# English {[en]} -> en
if [string equal $metadataLanguage $language] {set foundFlag 1; break}
}
}
}
# puts $foundFlag
if !$foundFlag {
# foundFlag == 0
# puts --$metadataRepList--
set metadataRep [lindex $metadataRepList 0] ;# name of the metadata repository which contains the metadata within the first/original language
if [string equal {} $metadataRep] {return} ;# metadataRep not found
}
# puts "metadataRep = --$metadataRep--"
# metadataRep found
if 0 {
# commented by GJFB in 2014-09-11 - doesn't work when the metadata repository has been deleted - in such situation, one must use FindMetadataRep2
if ![file isdirectory $homePath/col/$metadataRep] {
# the metadata repository has been deleted
UpdateVariables $metadataRep
# Check consistency with the file system
# CheckMetadataConsistency $metadataRep-0
set rep-iList $metadataRep-0
CheckMetadataConsistency rep-iList
# Check consistency with the file system - end
}
}
return $metadataRep
}
# FindMetadataRep - end
# ----------------------------------------------------------------------
# FindMetadataRep2
# reintroduced by GJFB in 2014-09-11 to be used in CompleteEntry when the repository has been deleted
# returns the first encountered which is not a metadata translation
# (returns the metadata repository name even though the metadata repository has been deleted)
# FindMetadataRep2 is case sensitive
# used in CompleteEntry only
proc FindMetadataRep2 {rep} {
# runs with post
global referenceTable
# global repositoryProperties
global homePath
foreach index [array names referenceTable *,$rep] {
regsub {,.*} $index {} metadataRep
# puts "metadataRep = --$metadataRep--"
if [TestContentType $metadataRep Metadata] {
if {$referenceTable($index) != "+"} {
set break 0
foreach index [array names referenceTable $metadataRep,*] {
if {$referenceTable($index) == "+"} {
# metadataRep contains a metadata translation
set break 1
}
}
if $break {continue} ;# metadataRep contains a metadata translation
# the metadata is in the first language
# puts OK1
if ![file isdirectory $homePath/col/$metadataRep] {
# the metadata repository has been deleted
# puts OK2
UpdateVariables $metadataRep
# Check consistency with the file system
# CheckMetadataConsistency $metadataRep-0
set rep-iList $metadataRep-0
CheckMetadataConsistency rep-iList
# Check consistency with the file system - end
}
return $metadataRep
}
}
}
# metadataRep not found
}
# FindMetadataRep2 - end
# ----------------------------------------------------------------------
# FindMetadataRepList
# Example:
# FindMetadataRepList dpi.inpe.br/banon/1998/08.02.08.56 .window.main.bc.rep.h2.entry.entry bc(result1)
# returns the metadata repository list for rep
# rep can be any repository (metadata repository or not)
# if it is a metadata repository FindMetadataRepList returns empty
# the original metadata is the first one (the others are translations)
proc FindMetadataRepList {rep {entryWidget {}} {varName {}}} {
# runs with start and post
global col
global applicationName
# set xxx [CallTrace]
# Store xxx C:/tmp/bbb.txt binary 0 a
if [string equal {} $rep] {
# not the repository syntax
# security issue - if $rep were empty, FindMetadataRepList could return all the metadata repositories
return
}
set metadataRepList {}
# example:
# child parent comment
# dpi.inpe.br/banon/1999/04.02.15.49,dpi.inpe.br/banon/1998/08.02.08.56 1 by TestContentType the child is metadata
# dpi.inpe.br/banon/2000/05.25.20.06,dpi.inpe.br/banon/1998/08.02.08.56 1 by TestContentType the child is metadata
# dpi.inpe.br/banon/2000/05.25.20.06,dpi.inpe.br/banon/1999/04.02.15.49 + child is translation metadata
# dpi.inpe.br/banon/1999/04.02.15.49,language {English [en]}
if {$applicationName == "start"} {
# start
# puts --$rep--
# puts --[Array names referenceTable *,$rep]--
foreach index [Array names referenceTable *,$rep] {
regsub {,.*} $index {} child
if ![file isdirectory $col/$child] {
# child doesn't exist
UpdateVariables $child ;# updates the keyRepositoryList
Eval UpdateVariables $child
regexp {^..} $varName xx ;# dd
SetIndicator $xx $entryWidget
} else {
# child exists
if [Eval TestContentType $child Metadata] {
if {[Get referenceTable($index)] != "+"} {
# metadataRepList
set index [lindex [Array names referenceTable *,$child] 0]
if {![string equal {} $index] && [Get referenceTable($index)] == "+"} {
# original metadata - must be the first language metadada
set metadataRepList [concat $child $metadataRepList]
} else {
lappend metadataRepList $child
}
}
}
}
}
}
if {$applicationName == "post"} {
# post
global referenceTable
# puts OK
# puts [info exists referenceTable]
foreach index [array names referenceTable *,$rep] {
# puts $index
regsub {,.*} $index {} child ;# a child repository (might be a metadata repository or a translation repository)
if ![file isdirectory $col/$child] {
# child doesn't exist
UpdateVariables $child
} else {
# child exists
# warning: if contentType is corrupted (e.g., empty) for $child which is a metadata repository, then one may get the error message:
# can't read "repositoryProperties(,history)": no such variable
# when running GetVersionStamp $metadataRep within GetURLPropertyList (during an IBI resolution)
if [TestContentType $child Metadata] {
# child is a metadata
if {$referenceTable($index) == "+"} {
# child is a metada translation
# rep has a metadata translation, that is
# rep is a metadata repository (a parent metadata repository) but metadata repository has no metadata repository therefore nothing to append
} else {
# rep is not a metadata repository
# metadataRepList
set index [lindex [array names referenceTable *,$child] 0]
if {![string equal {} $index] && $referenceTable($index) == "+"} {
# original metadata - must be the first language metadada
set metadataRepList [concat $child $metadataRepList]
} else {
lappend metadataRepList $child
}
}
}
}
}
}
# puts $metadataRepList
return $metadataRepList
}
if 0 {
# testing
source utilitiesStart.tcl
source utilities1.tcl
source cgi/mirrorfind-.tcl
source ../auxdoc/.referenceTable.tcl
source ../auxdoc/.repositoryProperties.tcl
set applicationName post
set col ../../../../..
FindMetadataRepList dpi.inpe.br/banon/1998/08.02.08.56
# => dpi.inpe.br/banon/1999/04.02.15.49 dpi.inpe.br/banon/2000/05.25.20.06
}
# FindMetadataRepList - end
# ----------------------------------------------------------------------
# AddItem
# Add a non-empty item in a list without repetition
# not used
proc AddItem2 {listName item} {
upvar #0 $listName inputList
set outputList $inputList
if {[lsearch -exact $outputList $item] == -1 && $item != ""} {
lappend outputList $item
}
return $outputList
}
# AddItem - end
# ----------------------------------------------------------------------
# MakeTargetKey
# makes the identification key when the document in $rep has no metadata
# used in CreateIdentificationKey only
proc MakeTargetKey {rep} {
# runs with post
global repositoryProperties
UpdateRepositoryProperties $rep targetfile
if [info exists repositoryProperties($rep,targetfile)] {
return :$repositoryProperties($rep,targetfile):
} else {
return ::
}
}
# MakeTargetKey - end
# ----------------------------------------------------------------------
# SourceLanguage
# example: SourceLanguage environmentArray
proc SourceLanguage {arrayName} {
# runs with start and post
upvar #0 $arrayName array
global col
global mirrorLanguageTable
global mirrorLanguageConversionTable
set currentLanguage $array(spLanguageEntry)
set repository $array(serviceLanguageRepository)
set currentLanguage2 $currentLanguage
# if [string equal {Português} $currentLanguage] {set currentLanguage2 {Portuguese}}
if [regexp {^Portugu.s$} $currentLanguage] {set currentLanguage2 {Portuguese}}
if [file exists $col/$repository] {
source $col/$repository/doc/${currentLanguage2}Language.tcl
}
set path [glob $col/$mirrorLanguageTable($currentLanguage2)/doc/mirror/*FieldName.tcl]
source $path
array set mirrorLanguageConversionTable [array get field::conversionTable]
}
# SourceLanguage - end
# ----------------------------------------------------------------------
# StoreList
proc StoreList {listName fileName {option {w}}} {
upvar #0 $listName list
if [catch {open $fileName w} fileId] {
puts stderr $fileId
} else {
puts $fileId "set $listName [list $list]"
close $fileId
}
}
# StoreList - end
# ----------------------------------------------------------------------
# CreateRepositoryList
proc CreateRepositoryList {} {
global repositoryList
global homePath
global pwd
if ![info exists repositoryList] {
cd $homePath/col
set repositoryList [glob -nocomplain */*/*/*]
cd $pwd
}
}
# CreateRepositoryList - end
# ----------------------------------------------------------------------
# StartService
proc StartService {} {
# runs with post
# global startService
global environmentArray
# global env
global auto_path
global URLibServiceRepository ;# set in post
global downloadingEnvironmentRepository ;# set in post
global URLibServiceMetadataRepositoryList
# global URLibBannerSequenceRepository
# global citationKeyRepository
# global searchRepository
global compileWordsRepository
global referRepository
global ${referRepository}::conversionTable
global orderingTable
global bib2referRepository
# global isis2referRepository
global bibpessoal2referRepository
global englishMirrorRepository
global defaultDocRepository
global defaultMetadataRepository
global defaultAccessIconRepository
global mirrorHomePageRepository
# global commonWordsRepList
global metadataArray
global repArray ;# may be created by the source procedure
global repArray2 ;# may be created by the source procedure (contains no accent and lower case only)
global authorArray
global groupArray
global committeeArray
global journalArray
global conferencenameArray
global wordOccurrenceArray
global mostRecentReferences
global mostRecentFullTexts
global saveMetadata
global loCoInRep ;# set in MakeRepository
# global loCoInMetadataRep ;# set in this procedure
global loBiMiRep ;# set in this procedure
global loBiMiMetadataRep ;# set in this procedure and used in MakeRepository
global referenceTable
global repositoryProperties
global col
global homePath
global pwd
# global keyRepositoryList
global commonWords
# global inverseTable
# global dateFieldPattern
# global localURLibClientSocketId
global repositoryList
global indexRepList
global bannerSequenceRepList
global officialIconRepList
# global abbreviationArray
global argv
global serverAddress
global serverAddressWithIP
# global urlibServerAddressWithIP ;# ip and port of urlib.net
global startApacheServer
global tcl_platform
global urlibServiceVersion
global devLoCoInRep ;# set in post
global maximumNumberOfEntries
global htpasswdPath
global tclPath
global wishPath
global repositoryListForPost
global repositoryListForStart
global installInitialCollection ;# set in post
global phpiniDirectoryPath
global urlibServiceSiteWithIP ;# set in post
global applicationName ;# set in post
global installationRegistrationPassword ;# used in MakeRepository
set saveMetadata 0 ;# just in case of a crash
foreach fileName [glob -nocomplain ../auxdoc/insertionOn-*] {
file delete $fileName ;# see EnterQueue
}
foreach fileName [glob -nocomplain ../auxdoc/tmpForAdministratorPassword-*] {
file delete $fileName ;# see Submit in submit.tcl
}
file delete ../auxdoc/processList ;# see StartApacheServer and Submit
# Install initial collection
if $installInitialCollection {
# installation begins here
Load C:/tmp/installationRegistrationPassword installationRegistrationPassword ;# added by GJFB in 2016-04-28 - just for installation from {gjfb.home 19050} - must match the value set in col/dpi.inpe.br/banon/2004/02.16.09.30.00/auxdoc/localCollectionPasswordArray.tcl in urlib.net
Load C:/tmp/installationAgencyResolverAddress installationAgencyResolverAddress ;# added by GJFB in 2017-02-20 - just for installation from {gjfb.home 19050} - example: bibdigital.sid.inpe.br - used to inform the urlib.net resolver, at the first connection, about the agency resolver providing support to the Archive
# set loCoInRep [CreateNewRepository]
CreateNewRepository ;# set loCoInRep (see MakeRepository)
set transferableFlag 0 ;# loCoInRep is not transferable
StoreService transferableFlag $loCoInRep transferableFlag 1 1
set visibility 1 ;# hidden
StoreService visibility $loCoInRep visibility 1 1
set repList $loCoInRep
set environmentArray(localCollectionIndexRepository) $loCoInRep
set fileContent {}
Store fileContent $col/$loCoInRep/doc/@siteList.txt
# Store fileContent $col/$loCoInRep/doc/@sitesForRepositoryCapture.txt
set fileContent {array set allowedSitesArray {}}
Store fileContent $col/$loCoInRep/doc/@sitesAllowedToTransferCopyright.tcl
set fileContent \
{All Sites
Main Site}
Store fileContent $col/$loCoInRep/doc/@sitesHavingReadPermission.txt
set environmentArray(sitesHavingReadPermission) [split $fileContent \n]
set fileContent {}
Store fileContent $col/$loCoInRep/doc/@sitesHavingWritePermission.txt
set environmentArray(sitesHavingWritePermission) [split $fileContent \n]
set type Index
Store type $col/$loCoInRep/service/type
# regsub {0\.} [expr [SortRandomNumber]/double(233280)] {} registrationPassword ;# added by GJFB in 2010-08-03 - needed by urlib.net for site authentication
# StoreService registrationPassword $loCoInRep registrationPassword 1 1 ;# added by GJFB in 2010-08-03
StoreService installationRegistrationPassword $loCoInRep registrationPassword 1 1 ;# added by GJFB in 2016-04-28
StoreService installationAgencyResolverAddress $loCoInRep agencyResolverAddress 1 1 ;# added by GJFB in 2017-02-20 - used just at the first connection to the urlib.net resolver
set loCoInMetadataRep [CreateNewRepository]
file delete $col/$loCoInMetadataRep/service/transferableFlag
# lappend repositoryList $loCoInMetadataRep
lappend repList $loCoInMetadataRep
set environmentArray(localCollectionIndexMetadataRepository) $loCoInMetadataRep ;# not used by URLibservice
set metadata "%0 Misc
%A URLib Librarian,
%T Local Collection Index at $loCoInRep
%I Deposited in the URlib collection.
%2 $loCoInMetadataRep
%4 $loCoInRep
%K metadata, URLib system."
Store metadata $col/$loCoInMetadataRep/doc/@metadata.refer
set targetFile metadata.cgi
Store targetFile $col/$loCoInMetadataRep/service/targetFile
# set repositoryProperties($loCoInMetadataRep,targetfile) $targetFile
set type Metadata
Store type $col/$loCoInMetadataRep/service/type
# set repositoryProperties($loCoInMetadataRep,type) $type
set reference ../$col/col/$loCoInRep
Store reference $col/$loCoInMetadataRep/service/reference
} else { ;# added by GJFB in 2016-04-28
# useful just for storing, if required, a new local collection password (registration key), different from installationRegistrationPassword, while the Archive is at gjfb
if [file exists C:/tmp/localCollectionPasswordArray.tcl] {
source C:/tmp/localCollectionPasswordArray.tcl ;# registration key - C:/tmp/localCollectionPasswordArray.tcl at gjfb - array set localCollectionPasswordArray
# array set localCollectionPasswordArray {
# urlib.net/www/2016/05.05.01.26 2211779955446611
# }
if [info exists localCollectionPasswordArray($loCoInRep)] {
set registrationPassword $localCollectionPasswordArray($loCoInRep)
StoreService registrationPassword $loCoInRep registrationPassword 1 1
}
}
}
if ![info exists environmentArray(localBibliographicMirrorRepository)] {
set installInitialCollection 1
set loBiMiRep [CreateNewRepository]
set transferableFlag 0 ;# loBiMiRep is not transferable
StoreService transferableFlag $loBiMiRep transferableFlag 1 1
set visibility 1 ;# hidden
StoreService visibility $loBiMiRep visibility 1 1
# lappend repositoryList $loBiMiRep
lappend repList $loBiMiRep
set environmentArray(localBibliographicMirrorRepository) $loBiMiRep
set targetFile mirror.cgi
Store targetFile $col/$loBiMiRep/service/targetFile
set reference ../$col/col/$mirrorHomePageRepository
Store reference $col/$loBiMiRep/service/reference
set type Mirror
Store type $col/$loBiMiRep/service/type
# set repositoryProperties($loBiMiRep,targetfile) $targetFile
set loBiMiMetadataRep [CreateNewRepository]
file delete $col/$loBiMiMetadataRep/service/transferableFlag
# lappend repositoryList $loBiMiMetadataRep
lappend repList $loBiMiMetadataRep
set environmentArray(localBibliographicMirrorMetadataRepository) $loBiMiMetadataRep ;# used just in LoadGlobalVariables
set metadata "%0 Misc
%A URLib Librarian,
%T Local Bibliographic Mirror at $loBiMiRep
%I Deposited in the URlib collection.
%2 $loBiMiMetadataRep
%3 mirror.cgi
%4 $loBiMiRep
%K metadata, URLib system."
Store metadata $col/$loBiMiMetadataRep/doc/@metadata.refer
# set targetFile @metadata.refer
set targetFile metadata.cgi
Store targetFile $col/$loBiMiMetadataRep/service/targetFile
# set repositoryProperties($loBiMiMetadataRep,targetfile) $targetFile
set type Metadata
Store type $col/$loBiMiMetadataRep/service/type
# set repositoryProperties($loBiMiMetadataRep,type) $type
set reference ../$col/col/$loBiMiRep
Store reference $col/$loBiMiMetadataRep/service/reference
# Create the @siteList.txt file in the loBiMiRep
if ![file exists $col/$loBiMiRep/doc/@siteList.txt] {
set fileContent {}
Store fileContent $col/$loBiMiRep/doc/@siteList.txt
}
# Create the @siteList.txt file in the loBiMiRep - end
## Create the @hidedMetadataRepositoryList.txt file in the loBiMiRep
# not used
# set hidedMetadataRepositoryList {} ;# show all metadata repositories
# Store hidedMetadataRepositoryList $col/$loBiMiRep/doc/@hidedMetadataRepositoryList.txt
## Create the @hidedMetadataRepositoryList.txt file in the loBiMiRep - end
}
if $installInitialCollection {
# Create the default document repository
file mkdir $col/$defaultDocRepository/auxdoc
file mkdir $col/$defaultDocRepository/source
file mkdir $col/$defaultDocRepository/doc
file mkdir $col/$defaultDocRepository/service
set fileContent [list [list 1999:09.19.18.20.04 dpi.inpe.br/banon/1999/01.09.22.14]]
Store fileContent $col/$defaultDocRepository/service/history
# StoreHostCollection $defaultDocRepository dpi.inpe.br/banon/1999/01.09.22.14 ;# there is no host collection containing the original
set visibility 1 ;# hidden
StoreService visibility $defaultDocRepository visibility 1 1
# lappend repositoryList $defaultDocRepository
lappend repList $defaultDocRepository
# Create the default document repository - end
# Create the metadata repository the for default document repository
set metadataRep dpi.inpe.br/banon/1999/09.19.22.25
file mkdir $col/$metadataRep/auxdoc
file mkdir $col/$metadataRep/source
file mkdir $col/$metadataRep/doc
file mkdir $col/$metadataRep/service
set fileContent {%0 Misc
%A URLib Librarian,
%T Default Document
%I Deposited in the URlib collection.
%2 dpi.inpe.br/banon/1999/09.19.22.25
%4 dpi.inpe.br/banon/1999/09.19.18.20
%K URLib system.
}
Store fileContent $col/$metadataRep/doc/@metadata.refer
set history [list [list 1999:11.27.20.37.56 dpi.inpe.br/banon/1999/01.09.22.14]]
Store history $col/$metadataRep/service/history
# StoreHostCollection $metadataRep dpi.inpe.br/banon/1999/01.09.22.14
set reference ../$col/col/dpi.inpe.br/banon/1999/09.19.18.20
Store reference $col/$metadataRep/service/reference
set targetFile metadata.cgi
Store targetFile $col/$metadataRep/service/targetFile
set fileContent Metadata
Store fileContent $col/$metadataRep/service/type
# lappend repositoryList $metadataRep
lappend repList $metadataRep
# Create the metadata repository for the default document repository - end
# Create the default metadata repository
file mkdir $col/$defaultMetadataRepository/auxdoc
file mkdir $col/$defaultMetadataRepository/source
file mkdir $col/$defaultMetadataRepository/doc
file mkdir $col/$defaultMetadataRepository/service
set fileContent {%0 Misc
%A URLib Librarian,
%D 2000
%T Default title
%I Deposited in the URLib collection.
}
Store fileContent $col/$defaultMetadataRepository/doc/@metadata.refer
set history [list [list 2000:01.08.01.46.07 dpi.inpe.br/banon/1999/01.09.22.14]]
Store history $col/$defaultMetadataRepository/service/history
# StoreHostCollection $defaultMetadataRepository dpi.inpe.br/banon/1999/01.09.22.14 ;# there is no host collection containing the original
set targetFile @metadata.refer
Store targetFile $col/$defaultMetadataRepository/service/targetFile
set visibility 1 ;# hidden
StoreService visibility $defaultMetadataRepository visibility 1 1
# lappend repositoryList $defaultMetadataRepository
lappend repList $defaultMetadataRepository
# Create the default metadata repository - end
# Create the metadata repository the for default metadata repository
set metadataRep dpi.inpe.br/banon/1999/09.12.15.17
file mkdir $col/$metadataRep/auxdoc
file mkdir $col/$metadataRep/source
file mkdir $col/$metadataRep/doc
file mkdir $col/$metadataRep/service
set fileContent {%0 Misc
%A URLib Librarian,
%T Default Metadata
%I Deposited in the URlib collection.
%2 dpi.inpe.br/banon/1999/09.12.15.17
%3 @metadata.refer
%4 dpi.inpe.br/banon/1999/09.12.15.10
%K metadata, URLib system.}
Store fileContent $col/$metadataRep/doc/@metadata.refer
set history [list [list 2000:01.08.01.46.07 dpi.inpe.br/banon/1999/01.09.22.14]]
Store history $col/$metadataRep/service/history
# StoreHostCollection $metadataRep dpi.inpe.br/banon/1999/01.09.22.14
set reference ../$col/col/dpi.inpe.br/banon/1999/09.12.15.10
Store reference $col/$metadataRep/service/reference
set targetFile metadata.cgi
Store targetFile $col/$metadataRep/service/targetFile
set fileContent Metadata
Store fileContent $col/$metadataRep/service/type
# lappend repositoryList $metadataRep
lappend repList $metadataRep
# Create the metadata repository for the default metadata repository - end
# Update history to have the correct most recent references
# set xxx [list $repList]
# Store xxx C:/tmp/xxx auto 0 a
foreach rep $repList {
set seconds [DirectoryMTime $homePath/col/$rep/doc]
set versionStamp [CreateVersionStamp $seconds]
UpdateHistory $rep $versionStamp
}
# Update history to have the correct most recent references - end
if [info exists repositoryList] {
set repositoryList [concat $repositoryList $repList]
} else {
set repositoryList $repList
}
# Update properties and references
foreach rep $repositoryList {
UpdateRepositoryProperties $rep
UpdateReferenceTable $rep
}
# UpdateReferenceFileForLoCoInRep
# Update properties and references - end
# SAVE
StoreArray repositoryProperties ../auxdoc/.repositoryProperties.tcl w list
StoreArray referenceTable ../auxdoc/.referenceTable.tcl w list
# SAVE - end
}
# Install initial collection - end
# Create orderingTable
# this ordering table is computed from the one in referRepository
# it is used in the FieldCompare procedure (utilitiesMirror.tcl)
array set orderingTable [CreateOrderingTable]
# Create orderingTable - end
# Create commonWords
set commonWords [${compileWordsRepository}::CompileWords [CreateCommonWordsRepList]] ;# needs repositoryProperties and referenceTable
# Create commonWords - end
if 0 {
# commented by GJFB in 2018-11-03 - urlibadm is now obsolete
# Create urlibadm advanced user
if ![file exists $col/$loCoInRep/auxdoc/urlibadmFlag] {
Load $col/$loCoInRep/auxdoc/@passwords.txt fileContent
if ![regexp {urlibadm:{SHA}} $fileContent] {
set line urlibadm:{SHA}CiW6WZExa92kqbOrzuIQYBbfKKA=
Store line $col/$loCoInRep/auxdoc/@passwords.txt auto 0 a
set urlibadmUserCreated 1 ;# could be anything
Store urlibadmUserCreated $col/$loCoInRep/auxdoc/urlibadmFlag
}
}
# Create urlibadm advanced user - end
}
# needed with post
## Create indexRepList
# Create bannerSequenceRepList
# Create officialIconRepList
set indexRepList {}
set bannerSequenceRepList {}
set officialIconRepList {}
foreach index [array names repositoryProperties *,type] {
regsub {,.*} $index {} rep
# Migration 15/9/07
if 1 {
if [TestContentType $rep Index] {
lappend indexRepList $rep
}
}
# Migration 15/9/07 - end
if [TestContentType $rep {Banner Sequence}] {
lappend bannerSequenceRepList $rep
}
if [TestContentType $rep {Access Icon}] {
if {$rep != "$defaultAccessIconRepository"} {
lappend officialIconRepList $rep
}
}
}
## Create indexRepList - end
# Create bannerSequenceRepList - end
# Create officialIconRepList - end
# Load bannerPathArray
LoadBannerPathArray
# Load bannerPathArray - end
## Inform the URLib system
# InformURLibSystem
## Inform the URLib system - end
if 0 {
# not used
# Create URLibServiceMetadataRepositoryList
# used in FindTheMostRecentReferences and CreateRepArray
set URLibServiceMetadataRepositoryList {}
set URLibServiceRepositoryList2 [CreateCitedRepositoryList $URLibServiceRepository]
lappend URLibServiceRepositoryList2 $URLibServiceRepository
foreach repName $URLibServiceRepositoryList2 {
set metadataRep [FindMetadataRep $repName]
if {$metadataRep != {}} {
set languageVersions [FindAllLanguageVersions $metadataRep]
foreach mRep $languageVersions {
# set xxx [list $repName $mRep]
# Store xxx C:/tmp/xxx auto 0 a
lappend URLibServiceMetadataRepositoryList $mRep
}
}
}
# Create URLibServiceMetadataRepositoryList - end
}
# Update OAI repository date
UpdateOAIRepositoryData
# Update OAI repository data - end
## UPDATE METADATA
# set metadataList {} ;# for add
# set metadata2List {} ;# for remove
# Create metadataArray, repArray and wordOccurrenceArray
set auxDoc $col/$URLibServiceRepository/auxdoc
set conditionA [expr [file exists $auxDoc/.metadataArray.tcl] && \
[file exists $auxDoc/.repArray.tcl] && \
[file exists $auxDoc/.repArray2.tcl] && \
[file exists $auxDoc/.authorArray.tcl] && \
[file exists $auxDoc/.groupArray.tcl] && \
[file exists $auxDoc/.committeeArray.tcl] && \
[file exists $auxDoc/.journalArray.tcl] && \
[file exists $auxDoc/.conferencenameArray.tcl] && \
[file exists $auxDoc/.wordOccurrenceArray.tcl]]
if $conditionA {
# .metadataArray.tcl, .repArray.tcl and .wordOccurrenceArray.tcl exist
LoadService $loCoInRep workingKey workingKey 1 1
set installationDatePlus60Days [expr ([ComputeNOD [join [lrange [file split $loCoInRep] 2 3] {.}]] + 60) * 24 * 3600]
if {$installationDatePlus60Days < [clock scan "Apr 30, 2006"] || \
![catch {set workingKey [Compress $workingKey]}] && \
[string compare $loCoInRep $workingKey] == 0} {
puts {licensed copy}
if [catch {
source $auxDoc/.repArray.tcl
source $auxDoc/.repArray2.tcl
} m] {
puts {.repArray.tcl or repArray2 has been deleted or is corrupted - it will be recreated}
file delete $auxDoc/.repArray.tcl
file delete $auxDoc/.repArray2.tcl
set conditionA 0
}
} else {
if {[clock seconds] <= $installationDatePlus60Days} {
puts "evaluating period - it expires on [clock format $installationDatePlus60Days -format "%b %d, %Y"]"
if [catch {
source $auxDoc/.repArray.tcl
source $auxDoc/.repArray2.tcl
} m] {
puts {.repArray.tcl or repArray2 has been deleted or is corrupted - it will be recreated}
file delete $auxDoc/.repArray.tcl
file delete $auxDoc/.repArray2.tcl
set conditionA 0
}
} else {
puts {evaluating period has expired - search has been disabled}
}
}
# use catch here ....
source $auxDoc/.metadataArray.tcl
source $auxDoc/.authorArray.tcl
source $auxDoc/.groupArray.tcl
source $auxDoc/.committeeArray.tcl
source $auxDoc/.journalArray.tcl
source $auxDoc/.conferencenameArray.tcl
source $auxDoc/.wordOccurrenceArray.tcl
# set saveMetadata 0
}
# Merged Archives
# must be after Create metadataArray (because of Select)
# when merging an Archive, ./reset & must be done
set repList [Select repository {contenttype, Index}] ;# returns a list of repository names
# puts --$repList--
if [info exists loCoInRep] {
set i [lsearch $repList $loCoInRep]
set repList [lreplace $repList $i $i]
}
# puts --$repList--
global deletedRepositoryList2 ;# for merged Archives - used in GetURLPropertyList only
global deletedIdentifierList2 ;# for merged Archives - used in GetURLPropertyList only
set deletedRepositoryList2 {}
set deletedIdentifierList2 {}
set deletedRecordList2 {} ;# for OAI-PMH
foreach rep $repList {
if [file exists $homePath/col/$rep/doc/@deletedRepositoryList.tcl] {
source $homePath/col/$rep/doc/@deletedRepositoryList.tcl ;# set deletedRepositoryList
set deletedRepositoryList2 [concat $deletedRepositoryList2 $deletedRepositoryList]
unset deletedRepositoryList
}
if [file exists $homePath/col/$rep/doc/@deletedIdentifierList.tcl] {
source $homePath/col/$rep/doc/@deletedIdentifierList.tcl ;# set deletedIdentifierList
set deletedIdentifierList2 [concat $deletedIdentifierList2 $deletedIdentifierList]
unset deletedIdentifierList
}
if [file exists $homePath/col/$rep/doc/@deletedRecordList.tcl] {
source $homePath/col/$rep/doc/@deletedRecordList.tcl ;# set deletedRecordList - used with OAI-PMH only (see iconet.com.br/banon/2003/11.21.21.08)
set deletedRecordList2 [concat $deletedRecordList2 $deletedRecordList]
unset deletedRecordList
}
}
# Merged Archives - end
# Load deletedRepositoryList and deletedIdentifierList
global deletedRepositoryList ;# used in GetURLPropertyList
if {[info exists loCoInRep] && [file exists $homePath/col/$loCoInRep/doc/@deletedRepositoryList.tcl]} {
source $homePath/col/$loCoInRep/doc/@deletedRepositoryList.tcl ;# set deletedRepositoryList
} else {
set deletedRepositoryList {}
}
global deletedIdentifierList ;# used in GetURLPropertyList
if {[info exists loCoInRep] && [file exists $homePath/col/$loCoInRep/doc/@deletedIdentifierList.tcl]} {
source $homePath/col/$loCoInRep/doc/@deletedIdentifierList.tcl ;# set deletedIdentifierList
} else {
set deletedIdentifierList {}
}
# Load deletedRepositoryList and deletedIdentifierList - end
# Update @deletedRecordList.tcl
if ![string equal {} $deletedRecordList2] {
if [file exists $homePath/col/$loCoInRep/doc/@deletedRecordList.tcl] {
source $homePath/col/$loCoInRep/doc/@deletedRecordList.tcl ;# set deletedRecordList - used with OAI-PMH only (see iconet.com.br/banon/2003/11.21.21.08)
set deletedRecordList2 [concat $deletedRecordList2 $deletedRecordList]
unset deletedRecordList
array set array $deletedRecordList2 ;# drop duplicated entries
set deletedRecordList2 [array get array] ;# drop duplicated entries
}
StoreArray deletedRecordList2 $homePath/col/$loCoInRep/doc/@deletedRecordList.tcl w list listforarray 1 deletedRecordList
}
# Update @deletedRecordList.tcl - end
# Migration 2007-11-30
if ![info exists repositoryListForPost] {set repositoryListForPost {}}
# Migration 2007-11-30 - end
# Migration 2008-08-13
if [file exists $col/$loCoInRep/service/reference] {
file delete $col/$loCoInRep/service/reference
}
# Migration 2008-08-13 - end
set parseCollection 0 ;# 1 means to parse the collection to find unexpected repository name like: ltid.inpe.br/sbsr/2002/goto-
if !$parseCollection {
if {!$conditionA || ![string equal {} $repositoryListForPost]} {
if $conditionA {
set repositoryList2 $repositoryListForPost
} else {
# all repositories
CreateRepositoryList
set repositoryList2 $repositoryList
}
set numberOfRepositories [llength $repositoryList2]
if $conditionA {
set log "reloading $numberOfRepositories repositories..."
} else {
# all repositories
set log "reloading all repositories ($numberOfRepositories)..."
}
puts [StoreLog {notice} {StartService (1)} $log]
file delete $auxDoc/.mostRecentReferences.tcl
file delete $auxDoc/.mostRecentFullTexts.tcl
file delete $homePath/robots2.txt
# FOREACH
foreach rep $repositoryList2 {
# puts $rep ;# the last printed is a corrupted repository
if [TestContentType $rep Metadata] { ;# TestContentType uses the global variable repositoryProperties updated in post through UpdateRepositoryProperties
# $rep contains a metadata
set metadata2List [GetMetadata $rep-*]
# REMOVE METADATA
RemoveMetadata $metadata2List
set metadataList {} ;# for add
if ![file exists $col/$rep/doc/@metadata.refer] {
if {$tcl_platform(platform) == "windows" && [string equal {start} $applicationName]} {
console show
}
puts {syntax error:}
puts {the metadata file doesn't exist in}
puts "$homePath/col/$rep/doc"
puts {or its name is not @metadata.refer}
puts {solution:}
puts {create a metadata file named @metadata.refer}
puts {press exit}
puts {start again URLibService}
vwait forever
}
if 0 {
# old code
# time consuming
# Force some fields based on information within the service directory
# repository
set repName [ReturnRepositoryName $rep]
# repName might be empty if referenceTable was corrupted and if service/reference doesn't exist
if {$repName == {}} {continue}
Load $col/$rep/doc/@metadata.refer fileContent
if [string equal {} $fileContent] {
if {$tcl_platform(platform) == "windows" && [string equal {start} $applicationName]} {
console show
}
puts {syntax error:}
puts {the metadata doesn't exist} ;# '
puts {the file:}
puts $homePath/$rep/doc/@metadata.refer
puts {doesn't exist or is empty} ;# '
puts {create the file and/or edit the file content}
puts {or delete the repository:}
puts $rep
puts {press exit}
puts {start again URLibService}
vwait forever
}
set referMetadata [UpdateRefer $fileContent [concat repository $repName]]
# target file
if [info exists repositoryProperties($repName,targetfile)] {
set referMetadata [UpdateRefer $referMetadata \
[concat targetfile $repositoryProperties($repName,targetfile)]]
}
## content type
# if [info exists repositoryProperties($repName,type)] {
# set referMetadata [UpdateRefer $referMetadata \
# [concat contenttype $repositoryProperties($repName,type)]]
# }
# Ordering $referMetadata
set entry2 \n[string trim $referMetadata \n]
regsub -all {@} $entry2 {#!#} entry2 ;# @ > #!#
regsub -all "\n%(\[^ \\.;,\])" $entry2 {@\1} entry2
regsub -all "\n" $entry2 { } entry2
set referMetadata {}
foreach field [lrange [split $entry2 @] 1 end] {
regsub -all {#!#} $field {@} field ;# #!# > @
lappend referMetadata %$field
}
set referMetadata [lsort -command ReferFieldCompare $referMetadata]
set referMetadata [join $referMetadata \n]
# Ordering $referMetadata - end
if ![string equal $referMetadata $fileContent] {
# Update @metadata.refer
Store referMetadata $col/$rep/doc/@metadata.refer
}
set fileContent $referMetadata
# Force some fields based on information within the service directory - end
} else {
# same code as in UpdateCollection
Load $col/$rep/doc/@metadata.refer fileContent
set encodingSystem [encoding system]
Load $col/$rep/service/encodingSystem encodingSystem2
if [string equal {utf-8} $encodingSystem] {
# encoding system is utf-8
if ![string equal {utf-8} $encodingSystem2] {
# service/encodingSystem didn't exist (was not utf-8)
# the service/encodingSystem file must be updated or created
Store encodingSystem $col/$rep/service/encodingSystem ;# inform the local encoding system
}
} else {
# encoding system is not utf-8
if [string equal {utf-8} $encodingSystem2] {
# service/encodingSystem was utf-8
# rep probably results from a migration
# code added by GJFB in 2010-11-23 - convertfrom utf-8 is NOT idempotent for all graphemes
set fileContent [encoding convertfrom $encodingSystem2 $fileContent] ;# solves the accent problem when migrating from a collection using utf-8 encoding - e.g., migrating J8LNKAN8RW/34BETDS from plutao to banon-pc3
set mtime [file mtime $col/$rep/doc/@metadata.refer]
Store fileContent $col/$rep/doc/@metadata.refer
file mtime $col/$rep/doc/@metadata.refer $mtime ;# restore mtime
file delete $col/$rep/service/encodingSystem
}
}
}
set metadataList [concat $metadataList [ConvertMultipleRefer2MetadataList 0 $fileContent $rep]]
set metadataList [concat $metadataList [CreateExtraFields $rep $serverAddress]]
# Add citationkey
array set metadataImport $metadataList
set citationkey [CreateCitationKey metadataImport $rep-0 1]
set metadataList [concat $metadataList [list $rep-0,citationkey $citationkey]]
# Add citationkey - end
# ADD METADATA
AddMetadata $metadataList
} elseif [TestContentType $rep {Bibliography Data Base}] {
# For collection created with Version 1.1
if {$tcl_platform(platform) == "unix" && \
[file isdirectory $homePath/col/$rep/bib]} {
set path1 [eval file join [lrange [file split $rep] 0 2]]
set path2 [lindex [file split $rep] end]
set firstCharacter [string index [exec ls -l $homePath/col/$path1 | grep $path2] 0]
if {$firstCharacter != "d"} {continue}
}
# For collection created with Version 1.1 - end
# not a symbolic link
LoadBiblioDB $rep
} else {
# no content type might occur with deleted repositories
if ![file isdirectory $homePath/col/$rep] {
# deleted repository - the deleted repository might be a metadata repository
# CheckMetadataConsistency $rep-0 ;# removes possible metadata
set rep-iList $rep-0
CheckMetadataConsistency rep-iList
}
# LoadService $rep visibility visibility 1 1
# LoadService $rep docPermission docPermission 0 1
# set booleanDocPermission [regexp {deny} $docPermission]
# UpdateRobotstxtFile $rep $visibility $booleanDocPermission ;# added by GJFB in 2011-06-13
}
}
if $conditionA {
set log "$numberOfRepositories repositories reloaded"
} else {
# all repositories
set log "all repositories reloaded"
}
puts $log
StoreLog {notice} {StartService (2)} $log
set saveMetadata 1
}
# Create metadataArray, repArray and wordOccurrenceArray - end
if ![string equal {} $repositoryListForPost] {
SaveRepositoryProperties 1
SaveReferenceTable 1
# set saveMetadata 1
SaveMetadata 1
# unset repositoryListForPost
set repositoryListForStart {}
if [file exists ../auxdoc/.repositoryListForStart.tcl] {
source ../auxdoc/.repositoryListForStart.tcl ;# set the variable repositoryListForStart
}
set repositoryListForStart [concat $repositoryListForPost $repositoryListForStart]
set repositoryListForStart [lsort -unique $repositoryListForStart]
StoreList repositoryListForStart ../auxdoc/.repositoryListForStart.tcl
file delete ../auxdoc/.repositoryListForPost.tcl
#
set repositoryListForPost {}
}
# file delete ../auxdoc/.repositoryListForPost.tcl
# Create mostRecentReferences and mostRecentFullTexts
if ![file exists $auxDoc/.mostRecentReferences.tcl] {
array set mostRecentReferences \
[FindTheMostRecentReferences metadataArray $maximumNumberOfEntries]
set saveMetadata 1
} else {
source $auxDoc/.mostRecentReferences.tcl
}
if ![file exists $auxDoc/.mostRecentFullTexts.tcl] {
array set mostRecentFullTexts \
[FindTheMostRecentReferences metadataArray $maximumNumberOfEntries 1]
set saveMetadata 1
} else {
source $auxDoc/.mostRecentFullTexts.tcl
}
# Create mostRecentReferences and mostRecentFullTexts - end
}
# Create robots.txt file
# the code below is sensible to unexpected repository name like: ltid.inpe.br/sbsr/2002/goto-
if 0 {
# old code
Load $homePath/robots.txt fileContent
set lineList [lrange [split [string trim $fileContent] \n] 1 end]
if {![file exists $homePath/robots.txt] || \
(!$conditionA && [lsearch -exact $lineList "Disallow: /"] == -1)} {
# robots.txt doesn't exist or reset has been enabled and robots.txt doesn't contain "Disallow: /"
CreateRepositoryList
set lineList {}
foreach rep $repositoryList {
if ![TestContentType $rep Metadata] {
if [file exists $homePath/col/$rep/service/visibility] {
LoadService $rep visibility visibility 1 1
if $visibility {
# hidden
set metadataRep [FindMetadataRep $rep]
set metadataRepList [FindAllLanguageVersions $metadataRep]
foreach item [concat $rep $metadataRepList] {
lappend lineList "Disallow: /col/$item"
}
}
}
}
}
set lineList [concat {{User-agent: *}} $lineList]
if {[llength $lineList] == 1} {
set lineList [concat $lineList {{Disallow:}}]
}
set fileContent [join $lineList \n]
Store fileContent $homePath/robots.txt
}
} else {
# new code
# Create robots.txt file
if {![file exists $homePath/robots.txt] || !$conditionA} {
# robots.txt doesn't exist or reset has been enabled
CreateRepositoryList
ConditionalSet defaultAuthenticationFlag environmentArray(spUseUserAuthentication) 0
if $defaultAuthenticationFlag {
set robotsLineList {{User-agent: *} {Disallow: /}}
} else {
set robotsLineList {{User-agent: *} {Disallow:}}
}
foreach rep $repositoryList {
if ![TestContentType $rep Metadata] {
if [catch {LoadService $rep visibility visibility 1 1} message] {
puts [StoreLog {alert} {StartService (3)} "error while loading visibility from $rep\n$message"]
exit
}
LoadService $rep docPermission docPermission 0 1
set booleanDocPermission [regexp {deny} $docPermission]
UpdateRobotstxtFile $rep $visibility $booleanDocPermission robotsLineList ;# added by GJFB in 2011-06-13
}
}
set fileContent2 [join $robotsLineList \n]
Store fileContent2 $homePath/robots2.txt ;# useful when it is necessary to withdraw Disallow: / in robots.txt; in this case it is sufficient to a copy the content of robots2.txt into robots.txt
if $defaultAuthenticationFlag {
set robotsLineList {{User-agent: *} {Disallow: /}}
set fileContent [join $robotsLineList \n]
} else {
set fileContent $fileContent2
}
Store fileContent $homePath/robots.txt
}
}
# Create robots.txt file - end
if $parseCollection {
puts {end of collection parsing - no unexpected repository names found}
exit
}
# Create environmentArray(mirrorRepList)
# used in SearchEntry and LoadReference
if ![info exists environmentArray(mirrorRepList)] {
CreateRepositoryList
foreach rep $repositoryList {
if [TestContentType $rep Mirror] {
lappend environmentArray(mirrorRepList) $rep
}
}
} else {
# update
foreach mirrorRep $environmentArray(mirrorRepList) {
# Migration 16/10/04
if 0 {
# not used
Load $col/$mirrorRep/doc/@hidedMetadataRepositoryList.txt fileContent
set fileContent [string trim $fileContent " \n"]
set environmentArray($mirrorRep,hidedmetadatarepositorylist) $fileContent
} else {
file delete $col/$mirrorRep/doc/@hidedMetadataRepositoryList.txt
if [info exists environmentArray($mirrorRep,hidedmetadatarepositorylist)] {
unset environmentArray($mirrorRep,hidedmetadatarepositorylist)
}
}
# Migration 16/10/04 - end
}
}
# Create environmentArray(mirrorRepList) - end
# Update the URLib local collection
if [file exists $homePath/newVersion] {
if {[info exists loCoInRep] && $loCoInRep != "$devLoCoInRep"} {
if [file exists ../auxdoc/.urlibServiceVersion.tcl] {
source ../auxdoc/.urlibServiceVersion.tcl ;# set urlibServiceVersion
} else {
set urlibServiceVersion 0
}
# set xxx $urlibServiceVersion
# Store xxx C:/tmp/aaa auto 0 a
source $homePath/newVersion ;# set updateLevel
# set xxx $updateLevel(4)
# Store xxx C:/tmp/aaa auto 0 a
set saveMetadata 1 ;## must be before ComputeRepositoryList
# Update URLibService
# see also start
Load $homePath/packedRepository packedRepository
if {[string equal $URLibServiceRepository $packedRepository] || \
[string equal $downloadingEnvironmentRepository $packedRepository]} {
# packedRepository is URLibServiceRepository or downloadingEnvironmentRepository
Load $homePath/repositoryList repList2
UpdateCollection $repList2
if [string equal [ReturnCommunicationAddress $urlibServiceSiteWithIP] $serverAddressWithIP] {
# the current site is the one having a copy of the URLibService last version (see post)
# Create the download file
foreach rep $repList2 {
if ![TestContentType $rep Metadata] {
set currentDownloadPermission [FindCurrentDownloadPermission $rep] ;# urlibServiceSiteWithIP must be a mirror site
if ![string equal {deny from all} $currentDownloadPermission] {
if [string equal $rep $packedRepository] {
file mkdir $homePath/col/$rep/download ;# the download folder must contain a .htaccess file with the directive: allow form all
file copy -force $homePath/doc.zip $homePath/col/$rep/download/doc.zip
} else {
regsub {@.*$} $environmentArray(spMailEntry) {} administratorUserName
# UpdateDownloadFile $rep ;# may set saveMetadata to 1
UpdateDownloadFile $rep 0 0 $administratorUserName ;# may set saveMetadata to 1
}
}
}
}
# Create the download file - end
}
}
# Update URLibService - end
# Migration 5/8/01
if {[string compare $updateLevel(6) $urlibServiceVersion] > 0} {
# old version - rename auxdoc
CreateRepositoryList
foreach rep $repositoryList {
if {[string compare $URLibServiceRepository $rep] != 0} {
if ![file isdirectory $homePath/col/$rep/source] {
if [file isdirectory $homePath/col/$rep/auxdoc] {
file rename $homePath/col/$rep/auxdoc $homePath/col/$rep/source
file mkdir $homePath/col/$rep/auxdoc
}
}
} else {
file mkdir $homePath/col/$rep/source
}
}
}
# Migration 5/8/01 - end
# Migration 23/9/01
if {[string compare $updateLevel(7) $urlibServiceVersion] > 0} {
# old version - add numberoffiles field
set metadataList {}
CreateRepositoryList
foreach rep $repositoryList {
foreach {size numberOfFiles} [ComputeInfo $rep] {break}
Store numberOfFiles $homePath/col/$rep/service/numberOfFiles
set repositoryProperties($rep,numberoffiles) $numberOfFiles
set metadataRep [FindMetadataRep $rep]
if {[string compare {} $metadataRep] != 0} {
foreach mRep [FindAllLanguageVersions $metadataRep] {
set metadataList [concat $metadataList [list \
$mRep-0,numberoffiles $numberOfFiles]]
}
}
}
AddMetadata $metadataList
set saveMetadata 1
}
# Migration 23/9/01 - end
# Migration 12/10/02
if {[string compare $updateLevel(9) $urlibServiceVersion] > 0} {
# old version - add notRegistered file
CreateRepositoryList
foreach rep $repositoryList {
if [file exists $homePath/col/$rep/service/registrationPassword] {
set notRegistered {}
Store notRegistered $homePath/col/$rep/service/notRegistered
}
}
}
# Migration 12/10/02 - end
# Migration 17/8/03
# puts $urlibServiceVersion
# puts $updateLevel(11)
if {[string compare $updateLevel(11) $urlibServiceVersion] > 0} {
# old version - include username
# puts {migrating...}
set metadataList {}
CreateRepositoryList
foreach rep $repositoryList {
if [file exists $col/$rep/service/userName] {
LoadService $rep userName userName 1 1
set metadataRep [FindMetadataRep $rep]
set metadataList [concat $metadataList [list \
$metadataRep-0,username $userName]]
}
}
AddMetadata $metadataList
set saveMetadata 1
}
# Migration 17/8/03 - end
# Migration 10/10/04
if {[string compare $updateLevel(13) $urlibServiceVersion] > 0} {
# old version - update visibility file
set urlibEnvironment [GetCitedRepositoryList $URLibServiceRepository]
lappend urlibEnvironment $URLibServiceRepository
set query {title, Parecer and referencetype, Misc}
# set reviewMetadataRepList [MultipleExecute [list $serverAddress] [list list GetMetadataRepositories {} 0 $query yes yes 0]]
set reviewMetadataRepList [MultipleExecute [list $serverAddressWithIP] [list list GetMetadataRepositories {} 0 $query yes yes 0]]
# puts $reviewMetadataRepList
set metadataList {}
set metadata2List {}
CreateRepositoryList
foreach rep $repositoryList {
if ![TestContentType $rep Metadata] {
set metadataRep [FindMetadataRep $rep]
if {![file exists $col/$rep/service/visibility] || \
[lsearch $reviewMetadataRepList $metadataRep-0] != -1} {
if {[lsearch $reviewMetadataRepList $metadataRep-0] == -1 && \
[lsearch $urlibEnvironment $rep] == -1} {
set visibility 0 ;# shown
} else {
set visibility 1 ;# hidden
}
# puts [list $rep $visibility]
StoreService visibility $rep visibility 1 1
set visibility2 [expr $visibility?{hidden}:{shown}]
UpdateMetadataField $metadataRep visibility \
$visibility2 metadataList metadata2List 1
if [TestContentType $rep {Bibliography Data Base}] {
if [info exists repArray($rep,databaserepository)] {
foreach rep-i $repArray($rep,databaserepository) {
set metadata2List [concat $metadata2List \
[GetMetadata ${rep-i},visibility]]
set metadataList [concat $metadataList [list \
${rep-i},visibility $visibility2]]
}
}
}
}
}
}
RemoveMetadata $metadata2List
AddMetadata $metadataList
set saveMetadata 1
}
# Migration 10/10/04 - end
# Migration 03/12/05
if {[string compare $updateLevel(14) $urlibServiceVersion] > 0} {
# old version - insert .htaccess file
puts {inserting access files...}
CreateRepositoryList
foreach rep $repositoryList {
if ![TestContentType $rep Metadata] {
UpdateAccessFile $rep
}
}
puts {access files inserted}
}
# Migration 03/12/05 - end
# Migration 05/06/11
if {[string compare $updateLevel(15) $urlibServiceVersion] > 0} {
# old version - insert .htaccess and .htaccess2 files in the agreement folder
puts {inserting access files in the agreement folder...}
CreateRepositoryList
set htaccessContent {Require user administrator}
foreach rep $repositoryList {
if ![TestContentType $rep Metadata] {
if [file isdirectory $homePath/col/$rep/agreement] {
Store htaccessContent $homePath/col/$rep/agreement/.htaccess
Store htaccessContent $homePath/col/$rep/agreement/.htaccess2
# Update mtime
if [file exists $homePath/col/$rep/agreement/autorizacao.pdf] {
if [catch {file mtime $homePath/col/$rep/agreement/autorizacao.pdf [clock seconds]} m] {
puts "mtime not updated for $homePath/col/$rep/agreement/autorizacao.pdf"
}
}
# Update mtime - end
}
}
}
puts {access files inserted in the agreement folder}
}
# Migration 05/06/11 - end
# Migration 20/12/15
if {[string compare $updateLevel(16) $urlibServiceVersion] > 0} {
# old version - add files service/metadataRepositoryList
puts {add files service/metadataRepositoryList...}
CreateRepositoryList
foreach rep $repositoryList {
set metadataRepList [FindMetadataRepList $rep]
set fileContent [join $metadataRepList \n]
StoreService fileContent $rep metadataRepositoryList 0 1
}
puts {files service/metadataRepositoryList added}
}
# Migration 20/12/15 - end
}
}
# Migration 15/9/07
if 0 {
# statistics of access are now within the service directory of each repository
if ![file exists $homePath/col/$loCoInRep/service/accessLog] {
puts {creating accessLog files...}
CreateRepositoryList
foreach rep $repositoryList {
if ![file exists $homePath/col/$rep/service/accessLog] {
if ![TestContentType $rep Metadata] {
set path [file split $rep]
set year [lindex $path 2]
set rest [lreplace $path 2 2]
regsub -all { } $rest {=} rest
set outputLineList {}
foreach indexRep $indexRepList {
set filePath [ConvertFilePath $homePath/col/$indexRep/doc/access/$year/$rest]
if {[string compare {} $filePath] != 0} {
Load $filePath fileContent
foreach line [split $fileContent \n] {
if [regexp {(.*)-(.*)} $line m day numberOfClicks] {
if {[set i [lsearch -regexp $outputLineList $day]] == -1} {
lappend outputLineList $line
} else {
set line2 [lindex $outputLineList $i]
if [regexp {.*-(.*)} $line2 m numberOfClicks2] {
incr numberOfClicks $numberOfClicks2
set outputLineList [lreplace $outputLineList $i $i "$day-$numberOfClicks"]
}
}
}
}
}
}
set fileContent [join [lsort $outputLineList] \n]
Store fileContent $homePath/col/$rep/service/accessLog
}
}
}
puts {accessLog files created}
}
}
# Migration 15/9/07 - end
# Migration 2008-06-01
# creation of service/transferableFlag file
if 0 {
if ![file exists $homePath/col/$loCoInRep/service/transferableFlag] {
puts {creating transferableFlag files...}
file delete $homePath/col/$defaultDocRepository/service/hostCollection
file delete $homePath/col/dpi.inpe.br/banon/1999/09.19.22.25/service/hostCollection
file delete $homePath/col/$defaultMetadataRepository/service/hostCollection
file delete $homePath/col/dpi.inpe.br/banon/1999/09.12.15.17/service/hostCollection
CreateRepositoryList
foreach rep $repositoryList {
if [file exists $homePath/col/$rep/service/hostCollection] {
if ![GetDocumentState $rep] {
file delete $homePath/col/$rep/service/hostCollection
UpdateRepositoryProperties $rep hostcollection
UpdateRepositoryListForPost $rep
}
}
if ![TestContentType $rep Metadata] {
if [file exists $homePath/col/$rep/service/hostCollection] {
if {[string equal $loCoInRep $rep] || [string equal $loBiMiRep $rep]} {
set transferableFlag 0
} else {
set transferableFlag 1
}
StoreService transferableFlag $rep transferableFlag 1 1
}
}
}
puts {transferableFlag files created}
}
}
# Migration 2008-06-01 - end
if 0 {
# commented by GJFB in 2016-04-28
# Migration 2010-10-09
set transferableFlag 0
StoreService transferableFlag $loCoInRep transferableFlag 1 1
StoreService transferableFlag $loBiMiRep transferableFlag 1 1
set metadataList {}
set metadata2List {}
set metadataRep [FindMetadataRep $loCoInRep]
UpdateMetadataField $metadataRep transferableflag $transferableFlag metadataList metadata2List 1
set metadataRep [FindMetadataRep $loBiMiRep]
UpdateMetadataField $metadataRep transferableflag $transferableFlag metadataList metadata2List 1
RemoveMetadata $metadata2List
AddMetadata $metadataList
set saveMetadata 1
# Migration 2010-10-09 - end
}
# Migration 17/10/04
# Create @passwords.txt and .userArray.tcl
if ![file exists $homePath/col/$loCoInRep/auxdoc/@passwords.txt] {
Load $homePath/col/$loCoInRep/auxdoc/@readPasswords.txt readPasswords
Load $homePath/col/$loCoInRep/auxdoc/@writePasswords.txt writePasswords
set readPassworList [split $readPasswords \n]
set writePassworList [split $writePasswords \n]
set passwordList $writePassworList
foreach line $readPassworList {
regexp {(.*):} $line m userName
if {[lsearch -regexp $writePassworList "^$userName:"] == -1} {
# not found
lappend passwordList $line
}
}
set passwords [join $passwordList \n]
Store passwords $homePath/col/$loCoInRep/auxdoc/@passwords.txt
}
if ![file exists $homePath/col/$loCoInRep/auxdoc/.userArray.tcl] {
if [file exists $homePath/col/$loCoInRep/auxdoc/.readUserArray.tcl] {
source $homePath/col/$loCoInRep/auxdoc/.readUserArray.tcl
}
if [file exists $homePath/col/$loCoInRep/auxdoc/.writeUserArray.tcl] {
source $homePath/col/$loCoInRep/auxdoc/.writeUserArray.tcl
}
array set userArray [array get writeUserArray]
set writeUserList [array names writeUserArray *,e-mailaddress]
foreach index [array names readUserArray *,e-mailaddress] {
regsub {,e-mailaddress} $index {} userName
if {[lsearch -regexp $writeUserList "^$userName,"] == -1} {
# not found
set userArray($index) $readUserArray($index)
}
}
StoreArray userArray $homePath/col/$loCoInRep/auxdoc/.userArray.tcl w list array 1
}
# Create @passwords.txt and .userArray.tcl - end
# Migration 17/10/04 - end
# Migration (done)
# removing the submitted papers
# for
# lagavulin.ltid.inpe.br:1905
if 0 {
set metadataRepList [GetMetadataRepositories dpi.inpe.br/lise/2002/05.13.12.20 0 {conferencen 11} no no 0]
foreach rep-i $metadataRepList {
regexp {(.*)-} ${rep-i} m metadataRep
set repositoryName $metadataArray($metadataRep-0,repository)
file delete -force $homePath/col/$repositoryName
puts "$repositoryName deleted"
file delete -force $homePath/col/$metadataRep
puts "$metadataRep deleted"
}
}
# the URLibService must then be restarded with the option -r
# Migration - end
if 1 {
# added by GJFB in 2018-07-15 for security reason
# Migration 2018-07-15
file delete -force $homePath/col/$loCoInRep/archive
# Migration 2018-07-15 - end
}
if 0 {
# used just for devLoCoInRep
source ../auxdoc/.urlibServiceVersion.tcl ;# set urlibServiceVersion
source $homePath/newVersion ;# set updateLevel
puts $urlibServiceVersion
puts $updateLevel(11)
puts [llength $repositoryList]
if {[string compare $updateLevel(11) $urlibServiceVersion] > 0} {
# old version - include username
puts {migrating...}
set metadataList {}
set metadata2List {}
CreateRepositoryList
foreach rep $repositoryList {
if [file exists $col/$rep/service/userName] {
LoadService $rep userName userName 1 1
set metadataRep [FindMetadataRep $rep]
# set metadataList [concat $metadataList [list $metadataRep-0,username $userName]]
UpdateMetadataField $metadataRep username $userName metadataList metadata2List 1
}
}
RemoveMetadata $metadata2List
AddMetadata $metadataList
set saveMetadata 1
}
}
# Update the URLib local collection - end
if {$tcl_platform(platform) == "unix"} {
# start
# start comes with doc.zip
if [file owned $homePath/start] {exec chmod 774 $homePath/start}
# post
set fileContent "#!/bin/sh
cd col/$URLibServiceRepository/doc
umask 2
PHPRC=$phpiniDirectoryPath
export PHPRC
$tclPath post $@"
Store fileContent $homePath/post
if [file owned $homePath/post] {exec chmod 774 $homePath/post}
# unpost
set fileContent "#!/bin/sh
cd $homePath/col/$URLibServiceRepository/doc
umask 2
$tclPath post -x
# cd $homePath
# ./kill"
Store fileContent $homePath/unpost
if [file owned $homePath/unpost] {exec chmod 774 $homePath/unpost}
# reset
set fileContent "#!/bin/sh
cd $homePath/col/$URLibServiceRepository/doc
umask 2
$tclPath post -x
# cd $homePath
# ./kill
# cd $homePath/col/$URLibServiceRepository/doc
PHPRC=$phpiniDirectoryPath
export PHPRC
$tclPath post -r $@"
Store fileContent $homePath/reset
if [file owned $homePath/reset] {exec chmod 774 $homePath/reset}
# updateURLibService
set fileContent "#!/bin/sh
cd $homePath/col/$URLibServiceRepository/doc
umask 2
$tclPath post -x -u
# cd $homePath
# ./kill
# cd $homePath/col/$URLibServiceRepository/doc
PHPRC=$phpiniDirectoryPath
export PHPRC
$tclPath post"
Store fileContent $homePath/updateURLibService
if [file owned $homePath/updateURLibService] {exec chmod 774 $homePath/updateURLibService}
}
# files used in Juliana's work
Store loCoInRep $homePath/loCoInRep
Store htpasswdPath $homePath/htpasswdPath
# Index creation
Load localIndexInOnePage.html fileContent
Store fileContent $homePath/col/$loCoInRep/doc/index.html
if ![file exists $homePath/col/$loCoInRep/service/targetFile] {
UpdateTargetFile $loCoInRep index.html 0
StoreArray repositoryProperties ../auxdoc/.repositoryProperties.tcl w list
}
# Index creation - end
# Check consistency with the file system
if 0 {
# usually redundant and time consuming
CreateRepositoryList
# Clean repository properties
set flag 0
foreach index [array names repositoryProperties] {
regsub {,.*} $index {} rep
if {[lsearch $repositoryList $rep] == -1} {
unset repositoryProperties($index)
set flag 1
}
}
if $flag {
# update .repositoryProperties.tcl
StoreArray repositoryProperties ../auxdoc/.repositoryProperties.tcl w list
}
# Clean repository properties - end
# Clean references
set flag 0
foreach index [array names referenceTable] {
regsub {,.*} $index {} rep1
regsub {.*,} $index {} rep2
if {[lsearch $repositoryList $rep1] == -1 || \
[lsearch $repositoryList $rep2] == -1} {
unset referenceTable($index)
set flag 1
}
}
if $flag {
# update .referenceTable.tcl
StoreArray referenceTable ../auxdoc/.referenceTable.tcl w list
}
# Clean references - end
}
# Check consistency with the file system - end
# SAVE
SaveMetadata 1
# SAVE - end
# urlibServiceVersion
set urlibServiceVersion [lindex [GetURLibServiceLastVersion] 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
StoreArrayWithBackup environmentArray ../auxdoc/.environmentArray.tcl w list ;# added by GJFB in 2010-08-05
StoreList urlibServiceVersion ../auxdoc/.urlibServiceVersion.tcl
# SAVE - end
# puts "servers at $serverAddress started"
# set startService 0 ;# service started - doesn't need to be started again
}
# StartService - end
# ----------------------------------------------------------------------
# CreatePermissionList
# creates and updates permissionList (in environmentArray)
# creates and updates languagePreference (in environmentArray) and
# creates and updates displayReviewButton (in environmentArray) as well
# used by StartService, PerformCheck and UpdateRepMetadataRep
## return 1 if apache must be stopped and started, and 0 otherwise
# displayControl.tcl -> environmentArray
proc CreatePermissionList {mirrorRepList} {
# runs with post
global col
global environmentArray
global loCoInRep ;# used when sourcing $col/$parentRepository/doc/displayControl.tcl
global homePath ;# used when sourcing $col/$parentRepository/doc/displayControl.tcl
# puts $mirrorRepList
if {[llength $mirrorRepList] != 1} {
foreach item [array names environmentArray *,permissionList] {
unset environmentArray($item)
}
foreach item [array names environmentArray *,languagePreference] {
unset environmentArray($item)
}
foreach item [array names environmentArray *,displayReviewButton] {
unset environmentArray($item)
}
}
foreach mirrorRep $mirrorRepList {
# puts $mirrorRep
# controlArray.tcl in doc customizes displayControl.tcl in doc
# displayControl.tcl in auxdoc customizes controlArray.tcl in doc
# auxdoc/displayControl.tcl should be used in place of auxdoc/@writePermission.tcl
set parentRepository [lindex [GetCitedRepositoryList $mirrorRep] 0] ;# dpi.inpe.br/banon/2000/01.23.20.24
if [info exists languagePreference] {unset languagePreference}
if ![info exists permissionListArray($parentRepository)] {
if [file exists $col/$parentRepository/doc/displayControl.tcl] {
set log "sourcing col/$parentRepository/doc/displayControl.tcl"
StoreLog {notice} {CreatePermissionList} $log
if [catch {source $col/$parentRepository/doc/displayControl.tcl}] {
global errorInfo
set log "\[[clock format [clock seconds] -format %Y:%m.%d.%H.%M.%S]\] CreatePermissionList (1): error while sourcing:\ncol/$parentRepository/doc/displayControl.tcl\n$errorInfo\n"
puts $log
Store log $homePath/@errorLog auto 0 a
} else {
if [info exists displayTable] {unset displayTable} ;# free memory location
# set environmentArray($mirrorRep,permissionList) $permissionList
ConditionalSet environmentArray($mirrorRep,permissionList) permissionList {}
# ConditionalSet environmentArray($mirrorRep,languagePreference) languagePreference en
ConditionalSet environmentArray($mirrorRep,languagePreference) languagePreference {}
ConditionalSet environmentArray($mirrorRep,displayReviewButton) displayReviewButton 1
set permissionListArray($parentRepository) $environmentArray($mirrorRep,permissionList)
set languagePreferenceArray($parentRepository) $environmentArray($mirrorRep,languagePreference)
set displayReviewButtonArray($parentRepository) $environmentArray($mirrorRep,displayReviewButton)
}
}
} else {
# added by GJFB in 2013-01-09 to avoid sourcing more than once
set environmentArray($mirrorRep,permissionList) $permissionListArray($parentRepository)
set environmentArray($mirrorRep,languagePreference) $languagePreferenceArray($parentRepository)
set environmentArray($mirrorRep,displayReviewButton) $displayReviewButtonArray($parentRepository)
}
foreach parentRepository [GetCitedRepositoryList $parentRepository] {
# dpi.inpe.br/banon/1999/05.03.22.11
if [TestContentType $parentRepository {Submission Form}] {
if ![info exists permissionListArray($parentRepository)] {
if [file exists $col/$parentRepository/doc/displayControl.tcl] {
set log "sourcing col/$parentRepository/doc/displayControl.tcl"
StoreLog {notice} {CreatePermissionList} $log
if [catch {source $col/$parentRepository/doc/displayControl.tcl}] {
global errorInfo
set log "\[[clock format [clock seconds] -format %Y:%m.%d.%H.%M.%S]\] CreatePermissionList (2): error while sourcing:\ncol/$parentRepository/doc/displayControl.tcl\n$errorInfo\n"
puts $log
Store log $homePath/@errorLog auto 0 a
}
}
if [info exists displayTable] {unset displayTable} ;# free memory location
if [file exists $col/$parentRepository/doc/controlArray.tcl] {
if [file exists $col/$parentRepository/doc/controlArray.tcl] {
set log "sourcing col/$parentRepository/doc/controlArray.tcl"
StoreLog {notice} {CreatePermissionList} $log
if [catch {source $col/$parentRepository/doc/controlArray.tcl}] {
global errorInfo
set log "\[[clock format [clock seconds] -format %Y:%m.%d.%H.%M.%S]\] CreatePermissionList (3): error while sourcing:\ncol/$parentRepository/doc/controlArray.tcl\n$errorInfo\n"
puts $log
Store log $homePath/@errorLog auto 0 a
}
}
foreach index [array names controlArray] {
set $index $controlArray($index)
}
}
if [file exists $col/$parentRepository/auxdoc/@writePermission.tcl] {
set log "sourcing col/$parentRepository/auxdoc/@writePermission.tcl"
StoreLog {notice} {CreatePermissionList} $log
if [catch {source $col/$parentRepository/auxdoc/@writePermission.tcl}] {
global errorInfo
set log "\[[clock format [clock seconds] -format %Y:%m.%d.%H.%M.%S]\] CreatePermissionList (4): error while sourcing:\ncol/$parentRepository/auxdoc/@writePermission.tcl\n$errorInfo\n"
puts $log
Store log $homePath/@errorLog auto 0 a
}
}
if [file exists $col/$parentRepository/auxdoc/displayControl.tcl] {
set log "sourcing col/$parentRepository/doc/auxdoc/displayControl.tcl"
StoreLog {notice} {CreatePermissionList} $log
if [catch {source $col/$parentRepository/auxdoc/displayControl.tcl}] {
global errorInfo
set log "\[[clock format [clock seconds] -format %Y:%m.%d.%H.%M.%S]\] CreatePermissionList (5): error while sourcing:\ncol/$parentRepository/auxdoc/displayControl.tcl\n$errorInfo\n"
puts $log
Store log $homePath/@errorLog auto 0 a
}
}
ConditionalSet environmentArray($mirrorRep,permissionList) permissionList {}
ConditionalSet environmentArray($mirrorRep,languagePreference) languagePreference en
# puts "$mirrorRep $environmentArray($mirrorRep,languagePreference)"
ConditionalSet environmentArray($mirrorRep,displayReviewButton) displayReviewButton 1
set permissionListArray($parentRepository) $environmentArray($mirrorRep,permissionList)
set languagePreferenceArray($parentRepository) $environmentArray($mirrorRep,languagePreference)
set displayReviewButtonArray($parentRepository) $environmentArray($mirrorRep,displayReviewButton)
break
} else {
set environmentArray($mirrorRep,permissionList) $permissionListArray($parentRepository)
set environmentArray($mirrorRep,languagePreference) $languagePreferenceArray($parentRepository)
set environmentArray($mirrorRep,displayReviewButton) $displayReviewButtonArray($parentRepository)
}
}
}
}
}
# CreatePermissionList - end
# ----------------------------------------------------------------------
# CreateOrderingTable
# this ordering table is computed from the one in referRepository
# it is used in the FieldCompare procedure (utilitiesMirror.tcl)
proc CreateOrderingTable {} {
global referRepository
global ${referRepository}::conversionTable
# global multipleLineReferFieldNamePattern
global multipleLineReferFieldNamePattern2
# foreach index [array names conversionTable *,%*] #
foreach index [array names conversionTable] {
set fieldName $conversionTable($index) ;# author
if {$fieldName == {}} {continue}
regexp {(.*),(%.*)} $index m referenceType referFieldName
set orderingTable($referenceType,$fieldName) [set ${referRepository}::orderingTable($referFieldName)]
# if [regexp {%A|%E|%Y|%\?|%@group|%@affiliation|%@electronicmailaddress} $referFieldName]
# if [regexp $multipleLineReferFieldNamePattern $referFieldName] # ;# commented by GJFB in 2018-01-07
if [regexp $multipleLineReferFieldNamePattern2 $referFieldName] { ;# added by GJFB in 2018-01-07 to exclude nexthigerunit and previous lowerunit
## add FIRST for some multiple line fields
# add FIRST for multiple line fields
set orderingTable($referenceType,first$fieldName) \
[set ${referRepository}::orderingTable($referFieldName)]
}
}
return [array get orderingTable] ;# {Misc,author 4 Misc,title 5}
}
# CreateOrderingTable - end
# ----------------------------------------------------------------------
# FindTheMostRecentReferences
## excludes all the parent repositories of the URLibService
# excludes all the hidden repositories
# removeTheOldest value is 0 or 1
# 1 means to remove the oldest entries (used by CreateRepArray)
# justFullTexts value is 0 or 1
# 1 means to consider just full texts
# Example:
# FindTheMostRecentReferences metadataArray 10
# ==>
# iconet.com.br/banon/2001/07.27.00.56.36-0,metadatalastupdate {2001:08.07.18.31.04 dpi.inpe.br/banon/1999/01.09.22.14}
proc FindTheMostRecentReferences {arrayName maximumNumberOfEntries {justFullTexts 0} {removeTheOldest 0}} {
# runs with post
global metadataArray
upvar #0 $arrayName metadataArray2 ;# may be metadataArray or mostRecentReferences or mostRecentFullTexts
set list {}
foreach {index stamp} [array get metadataArray2 *,metadatalastupdate] {
# if [regsub -- {-0[^-]*$} $index {} metadataRep] #
if [regsub -- {-0$} $index {} metadataRep] {
# keep only the -0 references
if {[info exists metadataArray($metadataRep-0,visibility)] && \
[string compare {shown} $metadataArray($metadataRep-0,visibility)] == 0} {
# keep only the visible references
if $justFullTexts {
regsub {,.*} $index {} rep-i
if [info exists metadataArray(${rep-i},size)] {
# keep only the references having a full text
lappend list [list $index $stamp]
}
} else {
lappend list [list $index $stamp]
}
}
}
}
# compare stamp
set list [lsort -command Compare10- $list]
if $removeTheOldest {
## remove the oldest index names
# foreach item [lrange $list $maximumNumberOfEntries end] {
# unset metadataArray2([lindex $item 0])
# }
unset metadataArray2
}
return [join [lrange $list 0 [expr $maximumNumberOfEntries - 1]]]
}
# not used and not tested
proc FindTheMostRecentReferences2 {} {
global metadataArray
set max 0
foreach {index stamp} [array get metadataArray *,metadatalastupdate] {
set date [lindex $stamp 0]
if {[string compare $date $max] == 1} {
set theMostRecentIndex $index
set theMostRecentStamp $stamp
set max $date
}
}
return [list $index $stamp]
}
# FindTheMostRecentReferences - end
# ----------------------------------------------------------------------
# FindTheMostRecentReferences2
# a more efficient coding
proc FindTheMostRecentReferences2 {maximumNumberOfEntries {justFullTexts 0}} {
# runs with post
global metadataArray
global repArray
set list {}
set i 1
foreach index [lsort -decreasing [array names repArray *:??.??.??.??.??,metadatalastupdate]] {
foreach rep-i $repArray($index) {
if [regexp -- {-0$} ${rep-i}] {
# keep only the -0 references
set rep-0 ${rep-i}
if {[info exists metadataArray(${rep-0},visibility)] && \
[string compare {shown} $metadataArray(${rep-0},visibility)] == 0} {
# keep only the visible references
if $justFullTexts {
if [info exists metadataArray(${rep-0},size)] {
# keep only the references having a full text
set list [concat $list [list ${rep-0},metadatalastupdate $metadataArray(${rep-0},metadatalastupdate)]]
if {$i == $maximumNumberOfEntries} {return $list}
incr i
}
} else {
set list [concat $list [list ${rep-0},metadatalastupdate $metadataArray(${rep-0},metadatalastupdate)]]
if {$i == $maximumNumberOfEntries} {return $list}
incr i
}
}
}
}
}
return $list
}
# FindTheMostRecentReferences2 - end
# ----------------------------------------------------------------------
# Compare10-
# used to compare stamp in GetMostRecentMetadataRep
proc Compare10- {a b} {
set a10 [lindex [lindex $a 1] 0]
set b10 [lindex [lindex $b 1] 0]
return [string compare $b10 $a10]
}
# Compare10- - end
# ----------------------------------------------------------------------
# LoadBannerPathArray
proc LoadBannerPathArray {} {
# runs with post
global bannerSequenceRepList
global URLibBannerSequenceRepository
global bannerPathArray
global col
# get the first encountered
set bannerSequenceRep [lindex $bannerSequenceRepList 0]
if {$bannerSequenceRep == "$URLibBannerSequenceRepository" && \
[llength $bannerSequenceRepList] > 1} {
set bannerSequenceRep [lindex $bannerSequenceRepList 1]
}
if [file exists $col/$bannerSequenceRep/doc/@bannerSequence.tcl] {
# bannerPathArray (set in @bannerSequence.tcl)
catch {source $col/$bannerSequenceRep/doc/@bannerSequence.tcl}
}
}
# LoadBannerPathArray
# ----------------------------------------------------------------------
# StoreHostCollection
proc StoreHostCollection {rep hostCollection} {
# runs with start and post
set var $hostCollection
StoreService var $rep hostCollection 1 1
}
if 0 {
# testing
set col ../../../../..
source utilities1.tcl
StoreHostCollection dpi.inpe.br/banon/2000/05.25.20.06 dpi.inpe.br/banon/1999/01.09.22.14
StoreHostCollection dpi.inpe.br/banon-pc2@80/2009/03.13.22.03 {dpi.inpe.br/banon/1999/01.09.22.14
dpi.inpe.br/banon/2003/12.10.19.30
dpi.inpe.br/banon/1999/01.09.22.14} ;# old data format
}
# StoreHostCollection - end
# ----------------------------------------------------------------------
# LoadHostCollection
# return an empty list if the hostCollection file was corrupted
proc LoadHostCollection {rep} {
LoadService $rep hostCollection data 1 1
return $data
}
if 0 {
# testing
set col ../../../../..
source cgi/mirrorfind-.tcl
source utilities1.tcl
source utilitiesStart.tcl
set homePath {C:/Gerald/URLib 2}
puts [LoadHostCollection dpi.inpe.br/banon/1999/05.03.22.11]
puts [LoadHostCollection iconet.com.br/banon/2000/12.30.22.40]
puts [LoadHostCollection dpi.inpe.br/banon-pc2@80/2009/03.13.22.03]
}
# LoadHostCollection - end
# ----------------------------------------------------------------------
# FindInternetAddress
#
# Finds host name, domain name and ip address
# used in post and start
proc FindInternetAddress {} {
# runs with start and post
global tcl_platform
global environmentArray
global installInitialCollection
global serverAddress
global serverAddressWithIP
if {$tcl_platform(platform) == "windows"} {
# exec ping -n 1 localhost > ../auxdoc/pingMessage
exec ping -4 -n 1 localhost > ../auxdoc/pingMessage ;# added by GJFB in 2010-10-01 - force IPv4
# Pinging banon-pc2 [127.0.0.1] with 32 bytes of data: ...
# Disparando gjfb [127.0.0.1] com 32 bytes de dados: ...
Load ../auxdoc/pingMessage fileContent
# serverName
# regexp {([^ ]*) \[([^\]]*)\]} $fileContent m serverName ipAddress
regexp {([^ ]*) \[[^\]]*\]} $fileContent m serverName ;# banon-pc2
# puts --$serverName--
# hostName
set hostName [info hostname]
# puts --$hostName--
if [string equal {localhost} $serverName] {set serverName $hostName}
# domainName
set domainName {}
if ![string equal {} $hostName] {
if ![regexp "^$hostName\.(.*)$" $serverName m domainName] {
# >>> here it is assumed that the host name doesn't contain any periods (.)
# regexp {^([^\.]*)\.(.*)$} $serverName m hostName domainName
regexp {^(.*?)\.(.*)$} $serverName m hostName domainName
}
} else {
# >>> here it is assumed that the host name doesn't contain any periods (.)
# regexp {^([^\.]*)\.(.*)$} $serverName m hostName domainName
regexp {^(.*?)\.(.*)$} $serverName m hostName domainName
}
if [string equal {} $hostName] {
set message {host name not found}
Store message ../auxdoc/messageForStart
exit
}
# Store serverName C:/tmp/bbb auto 0 a
# exec ping -n 1 $serverName > ../auxdoc/pingMessage
exec ping -4 -n 1 $serverName > ../auxdoc/pingMessage ;# added by GJFB in 2010-10-01 - force IPv4
# Pinging banon-pc2 [150.163.2.174] with 32 bytes of data: ...
# Pinging banon-pc2 [192.168.1.6] with 32 bytes of data: ...
# Pinging banon-pc2 [127.0.0.1] with 32 bytes of data: ...
# Pinging banon-pc3 [192.168.1.100] with 32 bytes of data: ...
# Disparando gjfb [fe80::2c34:2cb0:4033:511%8] com 32 bytes de dados: ...
Load ../auxdoc/pingMessage fileContent
# ipAddress
regexp {\[([^\]]*)\]} $fileContent m ipAddress
if ![info exists ipAddress] {
set message {ip address not found}
Store message ../auxdoc/messageForStart
exit
}
}
if {$tcl_platform(platform) == "unix"} {
if {$tcl_platform(os) == "Linux"} {
# Linux
# serverName
if [catch {exec ping -c 1 localhost > ../auxdoc/pingMessage}] {
# ping: unknown host localhost
# message gotten from licari.ibict.br
set serverName localhost
} else {
# PING banon-pc3 (127.0.0.1) 56(84) bytes of data. ...
# PING localhost (127.0.0.1) 56(84) bytes of data. ...
# PING netuno.dpi.inpe.br (127.0.0.1) 56(84) bytes of data. ...
# PING mtc-m18 (127.0.0.1) 56(84) bytes of data. ...
# PING localhost.localdomain (127.0.0.1) 56(84) bytes of data. ...
Load ../auxdoc/pingMessage fileContent
# regexp {([^ ]*) \(([^\)]*)\)} $fileContent m serverName ipAddress
regexp {([^ ]*) \([^\)]*\)} $fileContent m serverName ;# netuno.dpi.inpe.br
}
# hostName
set hostName [info hostname] ;# netuno.dpi.inpe.br mtc-m18
# if [string equal {localhost} $serverName] {set serverName $hostName} ;# use hostName
if [regexp {^localhost} $serverName] {set serverName $hostName} ;# use hostName - added by GJFB in 2014-11-01 - now ping might return localhost.localdomain instead of just localhost
# domainName
set domainName {}
if ![string equal {} $hostName] {
if ![regexp "^$hostName\.(.*)$" $serverName m domainName] {
# >>> here it is assumed that the host name doesn't contain any periods (.)
# regexp {^([^\.]*)\.(.*)$} $serverName m hostName domainName
regexp {^(.*?)\.(.*)$} $serverName m hostName domainName
}
} else {
# >>> here it is assumed that the host name doesn't contain any periods (.)
# regexp {^([^\.]*)\.(.*)$} $serverName m hostName domainName
regexp {^(.*?)\.(.*)$} $serverName m hostName domainName
}
if [string equal {} $hostName] {
set message {host name not found}
Store message ../auxdoc/messageForStart
exit
}
exec ping -c 1 $serverName > ../auxdoc/pingMessage
# PING hermes2.dpi.inpe.br (150.163.2.23) 56(84) bytes of data. ...
# PING netuno.dpi.inpe.br (127.0.0.1) 56(84) bytes of data. ...
# PING mtc-m18 (127.0.0.1) 56(84) bytes of data. ...
Load ../auxdoc/pingMessage fileContent
# ipAddress
regexp {\(([^\)]*)\)} $fileContent m ipAddress
if ![info exists ipAddress] {
set message {ip address not found}
Store message ../auxdoc/messageForStart
exit
}
} else {
# SunOS
set hostName [exec hostname]
if [string equal {} $hostName] {
set message {host name not found}
Store message ../auxdoc/messageForStart
exit
}
# ??? exec /usr/bin/nslookup $hostName > ../auxdoc/nslookupMessage
# exec nslookup $hostName > ../auxdoc/nslookupMessage
# if [catch {exec nslookup $hostName > ../auxdoc/nslookupMessage}] #
if [catch {ReturnFullServerNameIP $hostName} output] {
Load ../auxdoc/domainName.txt domainName
Load ../auxdoc/ipAddress.txt ipAddress
} else {
# >>> here it is assumed that the host name doesn't contain any periods (.)
regsub {\..*$} $hostName {} hostName ;# gemini.dpi.inpe.br -> gemini
foreach {fullServerName ipAddress} $output {break}
set domainName {}
# regexp "^$hostName\.(.*)" [lindex $itemList2 2] m domainName
regexp "^$hostName\.(.*)" $fullServerName m domainName
# set ipAddress [lindex $itemList2 3]
}
if [string equal {} $ipAddress] {
set message {ip address not found}
Store message ../auxdoc/messageForStart
exit
}
}
}
# Trying to find the domain name using nslookup
if [string equal {127.0.0.1} $ipAddress] {
foreach {fullServerName ipAddress} [ReturnFullServerNameIP $serverName] {break}
if [string equal {} $ipAddress] {
set ipAddress {127.0.0.1}
} else {
if [string equal {} $domainName] {
if ![regexp "^$hostName\.(.*)$" $fullServerName m domainName] {
# >>> here it is assumed that the host name doesn't contain any periods (.)
# regexp {^[^\.]*\.(.*)$} $fullServerName m domainName
regexp {^.*?\.(.*)$} $fullServerName m domainName
}
}
}
} else {
# puts --$domainName--
# => {}
if [string equal {} $domainName] {
foreach {fullServerName ip} [ReturnFullServerNameIP $serverName] {break}
# foreach {fullServerName ip} [ReturnFullServerNameIP $ipAddress] {break} ;# added by GJFB in 2012-07-01 - the domain name may be found using the ipAddress instead of the serverName - useful at c94a96c1.virtua.com.br <- this URL doesn't work (server not found)
# ip not used
# puts --$serverName--
# => gjfb
# puts --$hostName--
# => gjfb
# puts --$fullServerName--
# => gjfb.Home
if ![regexp "^$hostName\.(.*)$" $fullServerName m domainName] {
# >>> here it is assumed that the host name doesn't contain any periods (.)
# regexp {^[^\.]*\.(.*)$} $fullServerName m domainName
regexp {^.*?\.(.*)$} $fullServerName m domainName
}
}
}
# puts --$domainName--
# => Home
# Trying to find the domain name using nslookup - end
# >>> environmentArray(hostName) and environmentArray(domainName) might be fixed in post for dynamic IP
# in the example above, hostName becomes gjfb.home and domainName becomes {}
# OBS: environmentArray(hostName) is not the name of the virtual host (if any), it is just the computer name
# OBS: environmentArray(domainName) is used in GetServerAddress
# set environmentArray(hostName) $hostName
set environmentArray(hostName) [string tolower $hostName] ;# because rep is case-insensitive and because of env(PATH_INFO) that might contain the path info in lower case
set environmentArray(domainName) [string tolower $domainName] ;# because rep is case-insensitive (security issue - normaly should not be necessary)
set environmentArray(ipAddress) $ipAddress
# StoreArray environmentArray ../auxdoc/.environmentArray.tcl
# StoreArray environmentArray ../auxdoc/.environmentArray2.tcl ;# backup
# StoreArrayWithBackup environmentArray ../auxdoc/.environmentArray.tcl ;# added by GJFB in 2010-08-05
StoreArrayWithBackup environmentArray ../auxdoc/.environmentArray.tcl w list ;# added by GJFB in 2010-08-05
# puts [list $hostName $domainName $ipAddress]
# Update serverAddress and serverAddressWithIP
# added by GJFB in 2016-06-29 - avoids the need of a second post round when posting from a new Internet address
# puts >>>$environmentArray(ipAddress)
# puts >>>$serverAddressWithIP
if ![string equal $environmentArray(ipAddress) $serverAddressWithIP] {
if !$installInitialCollection {
set serverAddress [GetServerAddress] ;# banon-pc2.dpi.inpe.br 800
set serverAddressWithIP [GetServerAddress 1]
}
}
# Update serverAddress and serverAddressWithIP - end
}
# FindInternetAddress - end
# ----------------------------------------------------------------------
# ConvertHex
# used in FindInternetAddress for Windows 2000
proc ConvertHex {string1} {
foreach {character x} [split $string1 {}] {append string2 $character}
regsub -all {\\\n\n } $string2 {} string3
regsub {\n\n$} $string3 {} string3
regsub -all {,00} $string3 {} string3
foreach number [split $string3 ,] {
append string4 [binary format H2 $number]
}
return $string4
}
# ConvertHex - end
# ----------------------------------------------------------------------
# UpdateMetadataFromBiblioDB
# remove value is 0 or 1
# 1 means just to remove, not to load
# 0 means to load the bibliographic data base
# flag value is 0 or 1
# 0 means to ignore the - signal
# 1 means to take into account the - signal (at the beginning of the file)
# flag is used by Bib2Refer
proc UpdateMetadataFromBiblioDB {rep remove flag} {
# runs with post
# remove
if $remove {
set metadata2List [GetMetadata $rep-*]
RemoveMetadata $metadata2List
} else {
# load
LoadBiblioDB $rep $flag
}
}
# UpdateMetadataFromBiblioDB - end
# ----------------------------------------------------------------------
# UpdateMetadataFromBiblioDB2
# remove value is 0 or 1
# 1 means just to remove, not to load
# 0 means to load the bibliographic data base
# flag value is 0 or 1
# 0 means to ignore the - signal
# 1 means to take into account the - signal (at the beginning of the file)
# flag is used by Bib2Refer
proc UpdateMetadataFromBiblioDB2 {rep {remove 0} {flag 0}} {
# runs with start
global col
Set updateMetadataFromBiblioDBInUse 1
set log [clock format [clock seconds]]
Store log $col/$rep/doc/@log auto 0 a
set message [Eval UpdateMetadataFromBiblioDB $rep $remove $flag]
if {[regsub -all {^<|>$} $message {} message] == 2} {
set message [join $message \n]
Store message $col/$rep/doc/@log auto 0 a
}
Set updateMetadataFromBiblioDBInUse 0
}
# UpdateMetadataFromBiblioDB2 - end
# ----------------------------------------------------------------------
# LoadBiblioDB
# used in UpdateMetadataFromBiblioDB, UpdateCollection, StartService and Script (Administrator page) only
# flag value is 0 or 1
# 0 means to ignore the - signal
# 1 means to take into account the - signal (at the beginning of the file)
# flag is used by Bib2Refer
proc LoadBiblioDB {rep {flag 0}} {
# runs with post
# runs with cgi-script
# global col
global homePath
global metadataArray
global repositoryProperties ;# to test if running with post or cgi-script
global bib2referRepository
global bibpessoal2referRepository
global isis2referRepository
global inverseTable
global serverAddress
global environmentArray
global multipleLineFieldNameList
# set xxx LoadBiblioDB0
# Store xxx C:/tmp/aaa auto 0 a
set beSelective 0
set reference {}
if [file exists $homePath/col/$rep/doc/@reference.bib] {
Load $homePath/col/$rep/doc/@reference.bib fileContent
# beginWith-
set beginWith- [regexp {^-} $fileContent]
set beSelective [expr $flag && ${beginWith-}]
# source $homePath/col/$bib2referRepository/doc/Bib2Refer.tcl ;# for testing code adjustment
set reference [${bib2referRepository}::Bib2Refer $fileContent $beSelective]
} elseif [file exists $homePath/col/$rep/doc/@reference.refer] {
Load $homePath/col/$rep/doc/@reference.refer reference
} elseif [file exists $homePath/col/$rep/doc/@reference.isis] {
if [file isdirectory $homePath/col/$isis2referRepository] {
Load $homePath/col/$rep/doc/@reference.isis fileContent binary
set reference [${isis2referRepository}::Isis2Refer $fileContent $rep]
}
} elseif [file exists $homePath/col/$rep/doc/a.txt] {
if [file isdirectory $homePath/col/$isis2referRepository] {
Load $homePath/col/$rep/doc/a.txt fileContent binary
set reference [${isis2referRepository}::Isis2Refer $fileContent $rep]
}
} elseif [file exists $homePath/col/$rep/doc/A.txt] {
if [file isdirectory $homePath/col/$isis2referRepository] {
Load $homePath/col/$rep/doc/A.txt fileContent binary
set reference [${isis2referRepository}::Isis2Refer $fileContent $rep]
}
} elseif [file exists $homePath/col/$rep/doc/a.TXT] {
if [file isdirectory $homePath/col/$isis2referRepository] {
Load $homePath/col/$rep/doc/a.TXT fileContent binary
set reference [${isis2referRepository}::Isis2Refer $fileContent $rep]
}
} elseif [file exists $homePath/col/$rep/doc/A.TXT] {
if [file isdirectory $homePath/col/$isis2referRepository] {
Load $homePath/col/$rep/doc/A.TXT fileContent binary
set reference [${isis2referRepository}::Isis2Refer $fileContent $rep]
}
} elseif [file exists $homePath/col/$rep/doc/@reference.bp1] {
if [file isdirectory $homePath/col/$bibpessoal2referRepository] {
Load $homePath/col/$rep/doc/@reference.bp1 fileContent
set reference [${bibpessoal2referRepository}::BibPessoal2Refer $fileContent 0]
}
} elseif [file exists $homePath/col/$rep/doc/@reference.bp2] {
if [file isdirectory $homePath/col/$bibpessoal2referRepository] {
Load $homePath/col/$rep/doc/@reference.bp2 fileContent binary
set reference [${bibpessoal2referRepository}::BibPessoal2Refer $fileContent 1]
}
}
# Store rep C:/tmp/aaa auto 0 a
# Store reference C:/tmp/aaa auto 0 a
ConvertMultipleRefer2MetadataList 1 $reference $rep localMetadataArray ;# sets localMetadataArray
# set metadataList [array get localMetadataArray]
# Store metadataList C:/tmp/bbb.txt auto 0 a
# set numberOfRef [llength [array names localMetadataArray *,referencetype]]
# set numberOfRef [regsub -all {,referencetype} $metadataList {} m]
# array set localMetadataArray $metadataList
# set numberOfRef [llength [array names localMetadataArray *,referencetype]]
# Store numberOfRef C:/tmp/aaa auto 0 a
# set versionStamp [lindex $repositoryProperties($rep,history) end]
if [info exists repositoryProperties] {
# post running
set versionStamp [GetVersionStamp $rep] ;# need repositoryProperties
} else {
# cgi-scrip running
set versionStamp {}
}
# for {set i 1} {$i <= $numberOfRef} {incr i}
if !$beSelective {
# remove
set metadata2List [GetMetadata $rep-*]
RemoveMetadata $metadata2List
}
# visibility
LoadService $rep visibility visibility 1 1
if [string equal {} $visibility] {set visibility 0} ;# shown
foreach item [array names localMetadataArray *,index] {
set i $localMetadataArray($item)
set x 0; after 1 {set x 1}; vwait x ;# nice procedure
if $beSelective {
# remove
# set metadata2List [GetMetadata $rep-$i*] ;# commented by GJFB in 2013-06-10 - the comma is missing
set metadata2List [GetMetadata $rep-$i,*] ;# added by GJFB in 2013-06-10
RemoveMetadata $metadata2List
}
set index [array names localMetadataArray $rep-$i,metadatarepository]
if ![string equal {} $index] {
# there is a nonempty metadatarepository field (i.e., a metadataRep) in the reference $rep-$i
# example: see Achache reference in id 83LX3pFwXQZeBBx/onedv
# 102
set metadataRep $localMetadataArray($index)
if ![string equal {} $metadataRep] {
if [file isdirectory $homePath/col/$metadataRep] {
# remove
set metadata2List [array get metadataArray $metadataRep-0,*]
# Store metadata2List C:/tmp/aaa auto 0 a
RemoveMetadata $metadata2List
# Update @metadata.refer
# (metadata -> refer)
# similar to CreateFullReferEntry
set referenceType $localMetadataArray($rep-$i,referencetype)
# Store referenceType C:/tmp/bbb auto 0 a
# set xxx [array get localMetadataArray $rep-$i,*]
# set xxx [join $xxx \n]
# Store xxx C:/tmp/bbb auto 0 a
set output {}
set targetFile {}
foreach index [array names localMetadataArray $rep-$i,*] {
# value
set value $localMetadataArray($index)
# field
regsub {.*,} $index {} field
# Update localMetadataArray
unset localMetadataArray($index)
set localMetadataArray($metadataRep-0,$field) $value
# Update localMetadataArray - end
if [regexp {^citationkey$|^firstauthor$|^index$|^repository$} $field] {continue}
if [regexp {^targetfile$} $field] {set targetFile $value}
# if [regexp {^author|^editor|^programmer|^reporter|^cartographer|^base|^committee|^translator|^serieseditor|^source|^group|^affiliation|^supervisor} $field]
if {[lsearch -exact $multipleLineFieldNameList $field] != -1} {
# multiple line fields
foreach item $value {
lappend output "$inverseTable($referenceType,$field) $item"
}
} else {
lappend output "$inverseTable($referenceType,$field) $value"
}
}
foreach {repName output} \
[AddTwoFields $metadataRep $referenceType $targetFile $output] \
{break}
# set output [lsort -command ReferFieldCompare $output] ;# now in AddTwoFields
set output [join $output \n]
set path $homePath/col/$metadataRep/doc/@metadata.refer
Load $path fileContent
if ![string equal $output $fileContent] {
# update the @metadata.refer file content
Store output $path
regsub {@.*$} $environmentArray(spMailEntry) {} administratorUserName
# UpdateLastUpdate $metadataRep {}
UpdateLastUpdate $metadataRep {} none $administratorUserName
# MakeDownloadFile $repName 0 1
MakeDownloadFile $repName 0 1 0 $administratorUserName
}
# Update @metadata.refer - end
# Append repName to the repositoryListForStart file content
# (used to update keyRepositoryList in PerformCheck)
Store repName ../auxdoc/repositoryListForStart auto 0 a
# Append repName to the repositoryListForStart file content - end
# UPDATE METADATA
set metadataList {} ;# for add
set metadata2List {} ;# for remove
UpdateMetadataField $metadataRep index 0 metadataList metadata2List
UpdateMetadataField $metadataRep repository $repName metadataList metadata2List
set metadataList [concat $metadataList [CreateExtraFields $metadataRep $serverAddress]]
# set metadataList [concat $metadataList [CreateExtraFields $metadataRep [GetServerAddress]]]
RemoveMetadata $metadata2List
array set localMetadataArray $metadataList
# set xxx [CallTrace]
# Store xxx C:/tmp/aaa auto 0 a
# set xxx [array get localMetadataArray $metadataRep-0,*]
# set xxx [join $xxx \n]
# Store xxx C:/tmp/aaa auto 0 a
} else {
# Add the metadatalastupdate and databaserepository fields
set localMetadataArray($rep-$i,metadatalastupdate) $versionStamp
set localMetadataArray($rep-$i,databaserepository) $rep
# Add the metadatalastupdate and databaserepository fields - end
}
} else {
# metadataRep is empty (bibpessoal case)
# Add the metadatalastupdate and databaserepository fields
set localMetadataArray($rep-$i,metadatalastupdate) $versionStamp
set localMetadataArray($rep-$i,databaserepository) $rep
# Add the metadatalastupdate and databaserepository fields - end
}
} else {
# there is no metadataRep in the reference
# Add the metadatalastupdate and databaserepository fields
set localMetadataArray($rep-$i,metadatalastupdate) $versionStamp
set localMetadataArray($rep-$i,databaserepository) $rep
set localMetadataArray($rep-$i,visibility) [expr $visibility?{hidden}:{shown}]
# Add the metadatalastupdate and databaserepository fields - end
}
}
# ADD METADATA
# set metadataList [array get localMetadataArray]
# Store metadataList C:/tmp/aaa auto 0 a
AddMetadata [array get localMetadataArray]
}
# LoadBiblioDB - end
# ----------------------------------------------------------------------
# AddTwoFields
# adds the fields targetfile and repName
# targetFile -> repositoryProperties and service/targetFile
# targetFile and repName -> fieldList
# Example:
# AddTwoFields $metadataRep $referenceType $targetFile $fieldList
# used in LoadBiblioDB and LoadMetadata only
proc AddTwoFields {metadataRep referenceType targetFile fieldList} {
# runs with post
# global col
global homePath
global inverseTable
global repositoryProperties
set repName [ReturnRepositoryName $metadataRep]
# Add the targetfile field
if ![string equal {} $targetFile] {
# target file defined in the incoming metadata
set repositoryProperties($repName,targetfile) $targetFile
Store targetFile $homePath/col/$repName/service/targetFile
} else {
# no target file defined in the incoming metadata - use the existing value in repositoryProperties
if [info exists repositoryProperties($repName,targetfile)] {
set targetFile $repositoryProperties($repName,targetfile)
lappend fieldList "$inverseTable($referenceType,targetfile) $targetFile"
}
}
# Add the targetfile field - end
# Add the repository field
lappend fieldList "$inverseTable($referenceType,repository) $repName" ;# "%4 $repName"
set fieldList [lsort -command ReferFieldCompare $fieldList]
# Add the repository field - end
return [list $repName $fieldList]
}
# AddTwoFields - end
# ----------------------------------------------------------------------
# ReturnRepositoryName
# used in StartService
proc ReturnRepositoryName {metadataRep} {
# runs with post
global referenceTable
foreach index [array names referenceTable $metadataRep,*] {
if {$referenceTable($index) != "+"} {
regsub {.*,} $index {} repName
return $repName
}
}
# repName not found
# the referenceTable may have been damaged,
# Update referenceTable
UpdateReferenceTable $metadataRep ;# try to repair referenceTable - uses source/reference to recreate repName
# UpdateReferenceFileForLoCoInRep
# Update referenceTable - end
foreach index [array names referenceTable $metadataRep,*] {
if {$referenceTable($index) != "+"} {
regsub {.*,} $index {} repName
return $repName
}
}
# repName not found
# case of a bibliographic data base (is a set of metadata to no repository)
# returns empty
}
# ReturnRepositoryName - end
# ----------------------------------------------------------------------
# ReturnType
proc ReturnType {metadataArrayName rep-i {level {#0}}} {
# runs with start and post
upvar $level $metadataArrayName metadataArray
return $metadataArray(${rep-i},referencetype)
}
# ReturnType - end
# ----------------------------------------------------------------------
# GetServerAddress
# the ipFlag option is used to compare the server address
# with the result of GetURLibServerAddress
# in InformURLibSystem (this file) and FindBannerPath (utilitiesMirror.tcl)
# and to communicate via socket (using domain name instead of ip leads to: "too many nested evaluations (infinite loop?)")
# the result is always in the form {ipAddress urlibPort}
proc GetServerAddress {{ipFlag 0}} {
# runs with start and post
global environmentArray
if [regexp {(.*) +(.*)} $environmentArray(spPortEntry) m httpHostName urlibPortNumber] {
# environmentArray(spPortEntry) => {banon-pc2 800}
# environmentArray(spPortEntry) => {www.urlib.net 800}
if $ipFlag {
# set ipAddress $environmentArray(ipAddress)
# regsub {.$} $urlibPortNumber {} serverPort ;# drop the last digit
# set serverAddress $ipAddress:$serverPort
set serverName $environmentArray(ipAddress)
} else {
set hostName $httpHostName ;# banon-pc2 or www.urlib.net
if [regexp {\.} $hostName] {
# host name is already a full server name, e.g., www.urlib.net or banon-pc2.dpi.inpe.br
set serverName $hostName
} else {
set domainName $environmentArray(domainName)
if [string equal {} $domainName] {
set serverName $hostName
} else {
set serverName $hostName.$domainName ;# banon-pc2.dpi.inpe.br
}
}
}
set serverAddress [list $serverName $urlibPortNumber] ;# banon-pc2.dpi.inpe.br 800
} else {
# old usage
# environmentArray(spPortEntry) => {80}
# environmentArray(spPortEntry) => {1905}
if $ipFlag {
set serverName $environmentArray(ipAddress)
} else {
set hostName $environmentArray(hostName)
set domainName $environmentArray(domainName)
if [string equal {} $domainName] {
set serverName $hostName
} else {
set serverName $hostName.$domainName
}
}
set portNumber $environmentArray(spPortEntry)
set serverAddress $serverName:$portNumber
set serverAddress [ReturnCommunicationAddress $serverAddress] ;# banon-pc2.dpi.inpe.br:80 -> banon-pc2.dpi.inpe.br 800
}
return $serverAddress
}
# GetServerAddress - end
# ----------------------------------------------------------------------
# CreateNewRepository
# documentType value are empty or default or directory
# empty means to deposit nothing in the new repository
# default means to deposit the document from the default repository
# directory means to deposit a folder document named documentPath
# targetFileOption value is disable or enable
# option value is "copy" or "preserve" or "delete" (see DDRoutine)
# unzip value is 0 or 1; 1 means to unzip the deposited document
# contentType value is Metadata, External Contribution, ...
## copyToSource value is 0 or 1; 1 means to deposit the document into the source as well
# copyToSource value is 0 or 1; 1 means to deposit the document into the source (only)
# userName is the name of the advanced user who is creating the version stamp
# postSubmissionScriptRepList is a list of repositories containing scripts to process
# the submitted files
# $reference ==>
# {%0 Misc} {%@tertiarytype } {%A aa} {%I Deposited in the URLib collection.} {%X aa} {%T tt} {%@secondarykey INPE--/}
# reference is used for post-submission
proc CreateNewRepository {{documentType {empty}} {documentPath {}} \
{targetFileOption disable} {option copy} {unzip 0} {repName {}} \
{fileInfo 1} {contentType {}} {copyToSource 0} {userName {}} \
{postSubmissionScriptRepList {}} {reference {}}} {
# runs with start and post
set argument ""
set argument "$argument -targetfile $targetFileOption"
set argument "$argument -documenttype $documentType"
set argument "$argument -repositorytype new"
set argument "$argument -option $option"
set argument "$argument -reverse 0"
set argument "$argument -documentpath [list $documentPath]"
set argument "$argument -unzip $unzip"
set argument "$argument -fileinfo $fileInfo"
set argument "$argument -contenttype [list $contentType]"
set argument "$argument -copytosource $copyToSource"
set argument "$argument -username [list $userName]" ;# name of the advanced user who is creating the version stamp
set argument "$argument -postsubmissionscriptreplist [list $postSubmissionScriptRepList]"
set argument "$argument -reference [list $reference]"
# set xxx 1-$argument
# Store xxx C:/tmp/aaa auto 0 a
# set return [DDRoutine $argument]
set return [DDRoutine $argument 0 $repName]
if {$return == 1} {return}
if {$return == 0} {return}
return $return
}
# CreateNewRepository - end
# ----------------------------------------------------------------------
# CheckAccess
# used by UpdateRepository2 and UpdateRepMetadataRep
# password must be coded or a session number
# "no advanced user" for the rep is equivalent to "the administrator is the advanced user"
proc CheckAccess {rep userName password} {
# runs with post
global environmentArray
global repositoryProperties
set procedureName [lindex [info level [expr [info level] - 1]] 0]
regsub {@.*$} $environmentArray(spMailEntry) {} administratorUserName
if [info exists repositoryProperties($rep,username)] {
# there is a user with write permission for this repository
if ![regexp "^$repositoryProperties($rep,username)$|^administrator$|^$administratorUserName$" $userName] {
# $userName is neither this user nor the administrator
return "$procedureName: '$userName' has no write permission for the repository $rep"
}
} else {
# there is no user with write permission for this repository
if ![regexp "^administrator$|^$administratorUserName$" $userName] {
# $userName is not the administrator
return "$procedureName: '$userName' has no write permission for the repository $rep"
}
}
if [CheckPassword $userName $password] {
# return "$procedureName: the password is incorrect or the user name doesn't exist"
if [CheckSession $password $userName] {
return "$procedureName: the password is incorrect or the user name doesn't exist, or the session doesn't exist"
} else {
return ;# the session exists
}
}
# the password is correct
}
# CheckAccess - end
# ----------------------------------------------------------------------
# StorePassword2
# Secure version of StorePassword
## used to force a password in processMail in dpi.inpe.br/banon/2005/12.08.20.05
# used to force a password in cgi/createNewPassword.tcl in iconet.com.br/banon/2009/05.17.20.29 only
# password and administratorPassword must be coded
proc StorePassword2 {userName password administratorPassword} {
# Check administrator password
set checkPassordResponse [CheckPassword administrator $administratorPassword]
if $checkPassordResponse {
# if [CheckPassword urlibadm $administratorPassword read] # commented by GJFB in 2018-11-03 - urlibadm is now obsolete
## read is needed because urlibadm is just a read user (he has no full name)
# return "StorePassword2: no administrator or wrong administrator password"
return "StorePassword2: checkPassordResponse value is $checkPassordResponse, no administrator or wrong administrator password --$administratorPassword--"
# #
}
# Check administrator password - end
# Check user name
set return [CheckUsernamePassword $userName {} {} 1 read]
if [string equal {unknown username} $return] {
return "StorePassword2: $return"
}
# Check user name - end
# Waiting for the completion of other authentications
WaitQueue StorePassword2 authentication
# Waiting for the completion of other authentications - end
StorePassword $userName $password
# LeaveQueue [pid] authentication
LeaveQueue StorePassword2 authentication
}
# StorePassword2 - end
# ----------------------------------------------------------------------
# UpdateRepository2
# Secure version of UpdateRepository
# used by Submit (ePrint) and ProcessReview
# password must be coded
proc UpdateRepository2 {
rep metadataRep userName password {documentType {empty}}
{documentPath {}} {targetFileOption disable}
} {
# runs with post
global saveMetadata
set message [CheckAccess $rep $userName $password]
if {[string compare {} $message] != 0} {
return $message
}
# UpdateRepository $rep $documentType $documentPath $targetFileOption
UpdateRepository $rep $documentType $documentPath $targetFileOption copy 0 $userName
# UpdateLastUpdate $rep $metadataRep none
UpdateLastUpdate $rep $metadataRep none $userName
set metadataList {}
set metadata2List {}
if 0 {
# nextUser -> userName
if {[string compare {} $nextUser] != 0} {
StoreService nextUser $rep userName 1 1
UpdateMetadataField $metadataRep username \
$nextUser metadataList metadata2List
}
}
UpdateCrossReferences $rep $metadataRep metadataList metadata2List ;# uses $homePath/col/$rep/service/reference
# UPDATE METADATA (needed to process review)
RemoveMetadata $metadata2List
AddMetadata $metadataList
# SAVE
set saveMetadata 1
SaveMetadata
}
# UpdateRepository2 - end
# ----------------------------------------------------------------------
# UpdateRepository
# documentType value is empty or default or directory
# empty means to deposit nothing in the updated repository
# default means to deposit the document from the default repository
# directory means to deposit a folder document named documentPath
# targetFileOption value is disable or enable
# option value is "copy" or "preserve" or "delete" (see DDRoutine)
# unzip value is 0 or 1; 1 means to unzip the deposited document
# copyToSource value is 0 or 1; 1 means to deposit the document into the source (only)
# moveToSource value is 0 or 1 ; 0 means don't move, 1 move the doc content to source - added by GJFB in 2016-05-10 to preserve old doc content before updating it - set in Administrator page for customizing the conference submission forms (iconet.com.br/banon/2006/07.02.02.18)
# postSubmissionScriptRepList is a list of repositories containing scripts to process
# the submitted files
# $reference ==>
# {%0 Misc} {%@tertiarytype } {%A aa} {%I Deposited in the URLib collection.} {%X aa} {%T tt} {%@secondarykey INPE--/}
# reference is used for post-submission
# deleteDocContentBeforeUpdate value is 0 or 1; 1 means to delete the doc content before depositing the new document - 1 is default
# updateAgreement value is 0 or 1; 1 means to update the agreement folder
proc UpdateRepository {
rep {documentType {empty}} {documentPath {}}
{targetFileOption disable} {option copy} {unzip 0} {userName {}}
{postSubmissionScriptRepList {}} {reference {}} {deleteDocContentBeforeUpdate 1}
{copyToSource 0} {folderName {}} {updateAgreement 0} {moveToSource 0}
} {
# runs with start and post
set argument ""
set argument "$argument -targetfile $targetFileOption"
set argument "$argument -documenttype $documentType"
set argument "$argument -repositorytype repository"
set argument "$argument -option $option"
set argument "$argument -reverse 0"
set argument "$argument -documentpath [list $documentPath]"
set argument "$argument -repositoryentry [list [list :: $rep]]"
set argument "$argument -unzip $unzip"
set argument "$argument -selectedfiles no"
set argument "$argument -username $userName"
set argument "$argument -postsubmissionscriptreplist [list $postSubmissionScriptRepList]"
set argument "$argument -reference [list $reference]"
set argument "$argument -deletedoccontentbeforeupdate $deleteDocContentBeforeUpdate"
set argument "$argument -copytosource $copyToSource"
set argument "$argument -foldername [list $folderName]"
set argument "$argument -updateagreement $updateAgreement" ;# added by GJFB in 2010-12-05
set argument "$argument -movetosource $moveToSource" ;# added by GJFB in 2016-05-10
# set xxx 1-$argument
# Store xxx C:/tmp/aaa auto 0 a
set return [DDRoutine $argument]
# set xxx $return
# Store xxx C:/tmp/aaa auto 0 a
if {$return == 1} {return}
if {$return == 0} {return}
return $return
}
# UpdateRepository - end
# ----------------------------------------------------------------------
# GetFieldValue
# used by DisplayMultipleSearch
proc GetFieldValue {rep-i fieldName {level {#0}}} {
# runs with start and post
upvar $level metadataArray metadataArray
if [info exists metadataArray(${rep-i},$fieldName)] {
set fieldValue $metadataArray(${rep-i},$fieldName)
} else {
set fieldValue {}
}
return $fieldValue
}
# GetFieldValue - end
# ----------------------------------------------------------------------
# GetFieldValue2
# used to call GetFieldValue from MultipleSubmit
# used in Script (administrator page for unifying field values)
proc GetFieldValue2 {rep-i fieldName {level {#0}}} {
return [GetFieldValue ${rep-i} $fieldName $level]
}
# GetFieldValue2 - end
# ----------------------------------------------------------------------
# GetMetadata
# example:
# set metadata2List [GetMetadata $callingRep-0,metadatalastupdate]
# set metadata2List [GetMetadata $rep-*]
proc GetMetadata {index} {
# runs with post
global metadataArray
return [array get metadataArray $index]
}
# GetMetadata - end
# ----------------------------------------------------------------------
# RemoveMetadata
# Example:
# set metadata2List [concat $metadata2List [GetMetadata $metadataRep-*]]
# RemoveMetadata $metadata2List
# removeOnly value is 0 or 1
# 1 means only remove (no add follows remove) - used when a repository is deleted
proc RemoveMetadata {metadata2List {removeOnly 0} {metadataList {}}} {
# runs with post
global metadataArray
global searchRepository
global commonWords
global maximumNumberOfEntries ;# defined in LoadGlobalVariables
# Update abstract accelerator - added by GJFB in 2010-12-10
# get the difference between metadata2List and metadataList
array set newMetadataArray $metadataList
array set oldMetadataArray $metadata2List
# puts --[array names oldMetadataArray]--
set flag 0
foreach name [array names oldMetadataArray] {
# Update metadataArray
if [info exists metadataArray($name)] {unset metadataArray($name)}
# Update metadataArray - end
if [regexp {abstract|synopsis} $name] {
if [info exists newMetadataArray($name)] {
set flag 1 ;# metadata2List can be simplified
set oldMetadataArray($name) [ListNegatedImplication oldMetadataArray($name) newMetadataArray($name)]
}
}
}
if $flag {
# use a simplified metadata2List
set metadata2List [array get oldMetadataArray] ;# added by GJFB in 2010-12-10
}
# Update abstract accelerator - end
${searchRepository}::CreateRepArray $metadata2List $commonWords 1 $removeOnly $maximumNumberOfEntries
}
# RemoveMetadata - end
# ----------------------------------------------------------------------
# AddMetadata
# example: AddMetadata $metadataList
proc AddMetadata {metadataList {metadata2List {}}} {
# runs with post
global metadataArray
global searchRepository
global commonWords
# Update metadataArray
array set metadataArray $metadataList
# Update metadataArray - end
# Update abstract accelerator - added by GJFB in 2010-12-10
# get the difference between metadataList and metadata2List
if ![string equal {} $metadata2List] {
array set newMetadataArray $metadataList
array set oldMetadataArray $metadata2List
set flag 0
foreach name [array names newMetadataArray] {
if [regexp {abstract|synopsis} $name] {
if [info exists oldMetadataArray($name)] {
set flag 1 ;# metadataList can be simplified
set newMetadataArray($name) [ListNegatedImplication newMetadataArray($name) oldMetadataArray($name)]
}
}
}
if $flag {
# use a simplified metadataList
set metadataList [array get newMetadataArray] ;# added by GJFB in 2010-12-10
}
}
# Update abstract accelerator - end
${searchRepository}::CreateRepArray $metadataList $commonWords
}
# AddMetadata - end
# ----------------------------------------------------------------------
# CreateExtraFields
# creates fields which are not part of EndNote, i.e., targetfile, lastupdate,
# metadatalastupdate, contenttype, hostcollection, site, size, numberoffiles,
# language, username, agreement
# used in UpdateCollection and others
## not used in remote submission
# repositoryProperties -> metadataList
# service -> metadataList (visibility case)
# site is the server address (e.g., banon-pc2 19050)
proc CreateExtraFields {metadataRep site} {
# runs with post
global errorInfo
global environmentArray
set error 1 ;# needed to know if an error has actually occurred within the catch (because catch returns 1 when an error was catch before by another catch, e.g. by catch {puts $sock $query} in PutQuery)
set errorInfo {} ;# needed in order to get the correct return value when no error occurs
if [catch {
global repositoryProperties
global homePath
# puts [CallTrace]
set repName [ReturnRepositoryName $metadataRep]
set metadataList {}
# Add the targetfile field
if [info exists repositoryProperties($repName,targetfile)] {
set targetFile $repositoryProperties($repName,targetfile)
# puts $targetFile
set metadataList [concat $metadataList [list $metadataRep-0,targetfile $targetFile]]
}
# Add the targetfile field - end
# Add the last update fields
if [info exists repositoryProperties($metadataRep,history)] {
# set versionStamp [lindex $repositoryProperties($metadataRep,history) end]
set versionStamp [GetVersionStamp $metadataRep]
set metadataList [concat $metadataList [list $metadataRep-0,metadatalastupdate $versionStamp]]
}
if [info exists repositoryProperties($repName,history)] {
# set versionStamp [lindex $repositoryProperties($repName,history) end]
set versionStamp [GetVersionStamp $repName]
set metadataList [concat $metadataList [list $metadataRep-0,lastupdate $versionStamp]]
# set xxx [CallTrace]
# Store xxx C:/tmp/aaa auto 0 a
# Tcl Call Trace
# 5: CreateExtraFields iconet.com.br/banon/2000/12.30.22.40.05 banon-pc.dpi.inpe.br:1905
# 4: UpdateMetadataBase iconet.com.br/banon/2000/12.30.22.40.05 metadataList metadata2List banon-pc.dpi.inpe.br:1905 update
# 3: CheckMetadataConsistency iconet.com.br/banon/2000/12.30.22.40.05-0 10
# 2: GetMetadataRepositories 0 {repository, iconet.com.br/banon/2000/12.30.22.40} no no 1 metadatalastupdate
# 1: ServeLocalCollection sock22 150.163.8.245
# Tcl Call Trace - end
# set xxx [list versionStamp = $versionStamp]
# Store xxx C:/tmp/aaa auto 0 a
}
# Add the last update fields - end
# Add the contenttype field
if [info exists repositoryProperties($repName,type)] {
set contentType $repositoryProperties($repName,type)
set metadataList [concat $metadataList [list $metadataRep-0,contenttype $contentType]]
}
# Add the contenttype field - end
# Add the copyright field
if [info exists repositoryProperties($repName,copyright)] {
set copyright $repositoryProperties($repName,copyright)
set metadataList [concat $metadataList [list $metadataRep-0,copyright $copyright]]
}
# Add the copyright field - end
# Add the hostcollection field
if [info exists repositoryProperties($repName,hostcollection)] {
# if [GetDocumentState $repName] # ;# commented by GJFB in 2015-11-16 - metadataList should be identical to repositoryProperties to avoid missinterpretation
## the document is the original
set hostCollection $repositoryProperties($repName,hostcollection)
set hostCollection [lrange $hostCollection 0 end] ;# added by GJFB in 2012-05-03 - turn hostCollection a list without new lines - useful for old data format
set metadataList [concat $metadataList [list $metadataRep-0,hostcollection $hostCollection]]
# #
}
# Add the hostcollection field - end
# Add the site field
set metadataList [concat $metadataList [list $metadataRep-0,site $site]]
# Add the site field - end
# Add the size field
if [info exists repositoryProperties($repName,size)] {
set size $repositoryProperties($repName,size)
set metadataList [concat $metadataList [list $metadataRep-0,size $size]]
}
# Add the size field - end
# Add the numberoffiles field
if [info exists repositoryProperties($repName,numberoffiles)] {
set numberOfFiles $repositoryProperties($repName,numberoffiles)
set metadataList [concat $metadataList [list $metadataRep-0,numberoffiles $numberOfFiles]]
}
# Add the numberoffiles field - end
# Add the language field
if [info exists repositoryProperties($repName,language)] {
set language $repositoryProperties($repName,language)
regexp {\[(.*)\]} $language m language ;# English {[en]} -> en
set metadataList [concat $metadataList [list $metadataRep-0,language $language]]
}
# Add the language field - end
# Add the textlanguage field
# added by GJFB in 2013-02-11 to search for the proper metadata repository based on its language and display the corresponding entry in the proper language
# useful for multiple language document to display resume or archival unit document in the proper language
if [info exists repositoryProperties($metadataRep,language)] {
set language $repositoryProperties($metadataRep,language)
regexp {\[(.*)\]} $language m language ;# English {[en]} -> en
set metadataList [concat $metadataList [list $metadataRep-0,textlanguage $language]]
}
# Add the textlanguage field - end
# Add username
if [info exists repositoryProperties($repName,username)] {
set userName $repositoryProperties($repName,username)
set metadataList [concat $metadataList [list $metadataRep-0,username $userName]]
}
# Add username - end
# Add authenticatedusers/readergroup
if [info exists repositoryProperties($repName,authenticatedusers)] {
set readerGroup $repositoryProperties($repName,authenticatedusers)
set metadataList [concat $metadataList [list $metadataRep-0,readergroup $readerGroup]]
}
# Add authenticatedusers/readergroup - end
# Add childrepositories field
set childRepositories [GetCitingRepositoryList $repName]
# Drop the metadataRep from the childRepositories
set i [lsearch -exact $childRepositories $metadataRep]
set childRepositories [lreplace $childRepositories $i $i]
# Drop the metadataRep from the childRepositories - end
if ![string equal {} $childRepositories] {
set metadataList [concat $metadataList [list $metadataRep-0,childrepositories $childRepositories]]
}
# Add childrepositories field - end
# Add parentrepositories field
set parentRepositories [GetCitedRepositoryList $repName]
if ![string equal {} $parentRepositories] {
set metadataList [concat $metadataList [list $metadataRep-0,parentrepositories $parentRepositories]]
}
# Add parentrepositories field - end
# Add readpermission field
if 0 {
# new code below
if [info exists repositoryProperties($repName,docpermission)] {
set docPermission $repositoryProperties($repName,docpermission)
# puts 1-$docPermission
regsub -all "\n" $docPermission { and } readPermission
set metadataList [concat $metadataList [list $metadataRep-0,readpermission $readPermission]]
}
}
# administratorUserName
regsub {@.*$} $environmentArray(spMailEntry) {} administratorUserName
# ipAddress
set ipAddress $environmentArray(ipAddress)
# compute default access
foreach {defaultAuthenticationFlag spDocAccessPermission spDownloadAccessPermission directivesForCGI} [ComputeDefaultAccess $ipAddress 1] {break}
# compute access
foreach {authDirectives docPermission downloadPermission} [ComputeAccess $repName $administratorUserName $defaultAuthenticationFlag $spDocAccessPermission $spDownloadAccessPermission $ipAddress 1] {break}
# puts 2-$docPermission
if ![string equal {} $docPermission] {
# set docPermission2 [string trim $docPermission \n] ;# added by GJFB in 2011-04-10
set docPermission2 [string trim $docPermission] ;# added by GJFB in 2015-04-19 - tab must be trimmed as well (otherwise, Permission and Remote Permission in Dialog doesn't work properly)
regsub -all "\n" $docPermission2 { and } readPermission
set metadataList [concat $metadataList [list $metadataRep-0,readpermission $readPermission]]
}
# Add readpermission field - end
# puts [CallTrace]
# Add visibility field
if [file exists $homePath/col/$repName/service/visibility] {
LoadService $repName visibility visibility 1 1
set metadataList [concat $metadataList [list $metadataRep-0,visibility [expr $visibility?{hidden}:{shown}]]]
}
# Add visibility field - end
# Add identifier field
if [file exists $homePath/col/$repName/service/identifier] {
LoadService $repName identifier identifier 1 1
set metadataList [concat $metadataList [list $metadataRep-0,identifier $identifier]]
}
# Add identifier field - end
# Add transferableflag field
if [file exists $homePath/col/$repName/service/transferableFlag] {
LoadService $repName transferableFlag transferableFlag 1 1
set metadataList [concat $metadataList [list $metadataRep-0,transferableflag $transferableFlag]]
}
# Add transferableflag field - end
# Add agreement field
set dir $homePath/col/$repName/agreement
if [file isdirectory $dir] {
set fileList {}
DirectoryContent fileList $dir $dir
set metadataList [concat $metadataList [list $metadataRep-0,agreement $fileList]]
}
# Add agreement field - end
set error 0 ;# no error has occurred
return $metadataList
} m] {
if !$error {return $m}
lappend message "CreateExtraFields ([clock format [clock seconds]]):"
lappend message [CallTrace]
set log [join $message \n]
puts $log
Store log $homePath/@errorLog auto 0 a
error $m $errorInfo
}
}
# CreateExtraFields - end
# ----------------------------------------------------------------------
# UpdateSiteList
# Include/exclude Archive
# Updates the file @siteList.txt in the local bibliographic mirror repository.
# used only by InformURLibSystem
# siteRepIp is the list consisting of six elements:
# archiveaddress the archive internet address,
# archiveserviceibi the archive local collection index ibi,
# archiveip the archive ip address,
# archiveprotocol the archive protocol,
# archiveplatformversion the archive URLibService repository last update,
# archiveadmemailaddress the archive administrator e-mail address
#
## last update and e-mail address are optional
# Examples of the first three fields:
# banon-pc.dpi.inpe.br:1906 dpi.inpe.br/banon/1999/09.07.13.24 150.163.8.245
# banon-pc.dpi.inpe.br:1906 dpi.inpe.br/banon/1999/09.07.13.24 150.163.8.245 {2000:03.25.23.09.12 dpi.inpe.br/banon/1999/01.09.22.14}
# localCollectionPassword is the local collection password stored in service of loCoInRep
# it used to allow local collection with dynamic IP, updating @siteList.txt
## update of localCollectionPasswordArray.tcl requires executing unpost/post
# unpostFlag value is 0 or 1; 1 means that the remote local collection is beeing unposted
# @siteList.txt doesn't contain the reference to the current (i.e., local) site
# new version by GJFB in 2010-08-03 for security reason (to control access from dynamic IP)
proc UpdateSiteList {siteRepIp {localCollectionPassword {}} {unpostFlag 0}} {
# runs with post
global loBiMiRep
global loCoInRep
global col
# global localCollectionIndexDBRepository ;# commented by GJFB in 2010-08-04
global localCollectionPasswordArray ;# added by GJFB in 2010-08-03
# return 1 ;# for testing communication
if 0 {
# old code
if {![info exists localCollectionPasswordArray] && \
([file exists $col/$loBiMiRep/auxdoc/localCollectionPasswordArray.tcl] || \
[file exists $col/$loBiMiRep/auxdoc/localCollectionPasswordArrayBackup.tcl])} {
SourceWithBackup $col/$loBiMiRep/auxdoc/localCollectionPasswordArray.tcl localCollectionPasswordArray ;# set localCollectionPasswordArray
# localCollectionPasswordArray: loCoInRep |-> localCollectionPassword
# example: set localCollectionPasswordArray(dpi.inpe.br/banon/1999/01.09.22.14) 896322016416
# localCollectionPasswordArray must contain the local collection passwords of all the created local collections
}
} else {
# new code by GJFB in 2014-11-03 - for security reason localCollectionPasswordArray must be updated manually
if [file exists $col/$loBiMiRep/auxdoc/localCollectionPasswordArray.tcl] {
set mTime [file mtime $col/$loBiMiRep/auxdoc/localCollectionPasswordArray.tcl]
} else {
set mTime 0
}
if [file exists $col/$loBiMiRep/auxdoc/sourceTime] {
Load $col/$loBiMiRep/auxdoc/sourceTime sourceTime
} else {
set sourceTime 0
}
# $mTime > $sourceTime means that localCollectionPasswordArray.tcl has been updated manually and should be sourced
# localCollectionPasswordArray
if {(![info exists localCollectionPasswordArray] || $mTime > $sourceTime) && \
([file exists $col/$loBiMiRep/auxdoc/localCollectionPasswordArray.tcl] || \
[file exists $col/$loBiMiRep/auxdoc/localCollectionPasswordArrayBackup.tcl])} {
SourceWithBackup $col/$loBiMiRep/auxdoc/localCollectionPasswordArray.tcl localCollectionPasswordArray ;# source the most recent file - set localCollectionPasswordArray
set sourceTime [clock seconds]
Store sourceTime $col/$loBiMiRep/auxdoc/sourceTime
# localCollectionPasswordArray: loCoInRep |-> localCollectionPassword
# example: set localCollectionPasswordArray(dpi.inpe.br/banon/1999/01.09.22.14) 896322016416
# localCollectionPasswordArray must contain the local collection passwords of all the created local collections
}
}
# site index (of the remote collection)
## foreach {site index ip} $siteRepIp {break}
## ip not used
foreach {site index} $siteRepIp {break}
if 0 {
# old scheme
if ![info exists localCollectionPasswordArray($index)] {return}
if ![string equal $localCollectionPassword $localCollectionPasswordArray($index)] {return}
} else {
# communication scheme step 5
if ![info exists localCollectionPasswordArray($index)] {return 2} ;# do nothing - Archive not yet registered - added by GJFB in 2014-11-04 for security reason
if ![string equal $localCollectionPassword $localCollectionPasswordArray($index)] {return 3} ;# do nothing - unfair request - wrong localCollectionPassword - added by GJFB in 2014-11-04 for security reason
}
# siteWithIP (of the remote collection)
set serverAddress [ReturnCommunicationAddress $site] ;# server address of the remote collection
# foreach {serverName urlibPort} $serverAddress {break}
# set siteWithIP [list $ip $urlibPort]
## Inclusion/exclusion confirmation
if !$unpostFlag { ;# if added by GJFB in 2018-05-25
# Inclusion confirmation
## security issue
if 0 {
# using USP (URLibService protocol)
# communication scheme step 3
set command [list list ReturnConfirmation]
# MULTIPLE SUBMIT
# set siteRepIpConfirmation [MultipleExecute [list $siteWithIP] $command] ;# commented by GJFB in 2010-12-08 - banon-pc3 returns to urlib.net (not ismm.dpi.inpe.br) when using ip 187.106.147.7 (provided by net)
# puts --$serverAddress-- ;# only port 1905 is allowed from dpi.inpe.br
# set siteRepIpConfirmation [MultipleExecute [list $serverAddress] $command] ;# added by GJFB in 2010-12-08 - banon-pc3 doesn't return when using an empty domain name - this is the correct behavior
set confirmation [MultipleExecute [list $serverAddress] $command] ;# added by GJFB in 2010-12-08 - banon-pc3 doesn't return when using an empty domain name - this is the correct behavior
} else {
# using HTTP
package require http
# servicesubject=inclusionConfirmationRequest
# communication scheme step 3
set queryString servicesubject=inclusionConfirmationRequest
set site2 [ReturnHTTPHost $site]
## J8LNKB5R7W/3FTRH3S == Archive service for IBI resolution
# http://gjfb0520.sid.inpe.br/dpi.inpe.br/banon/2001/02.23.19.23?servicesubject=inclusionConfirmationRequest
# http://licuri.ibict.br/urlib.net/www/2017/10.16.01.16?servicesubject=inclusionConfirmationRequest
# => confirmation yes
# if [catch {http::geturl [ConvertURLToHexadecimal http://$site2/J8LNKB5R7W/3FTRH3S?$queryString]} token] #
if [catch {http::geturl [ConvertURLToHexadecimal http://$site2/$index?$queryString 1]} token] {
# puts --$token-- ;# error message - --couldn't open socket: connection refused--
# set siteRepIpConfirmation {} ;# no response
set confirmation {} ;# no response
} else {
# geturl returned
if [string equal {404} [::http::ncode $token]] {
# not found
# puts {not found}
# set siteRepIpConfirmation {} ;# no response
set confirmation {} ;# no response
} else {
# puts OK
# set siteRepIpConfirmation [string trimright [http::data $token]]
set confirmation [string trimright [http::data $token]]
}
http::cleanup $token
}
}
# puts --$confirmation--
# if [string equal {} $siteRepIpConfirmation] #
if [string equal {} $confirmation] {
# no response
# probably a local collection using dynamic IP - use the local collection password to confirm
# local collection using dynamic IP cannot be registred for security reason
set staticIPFlag 0 ;# added by GJFB in 2010-08-14
# use as siteRepIp the proper argument of the proc
} else {
# confirmation received
set staticIPFlag 1 ;# added by GJFB in 2010-08-14
if [string equal $index $loCoInRep] {
# remote == current - don't add
return $staticIPFlag ;# return 1 - if left empty, one cannot create a new repository
}
if 0 {
# commented by GJFB in 2014-11-03
# for security reason localCollectionPasswordArray must be updated manually
if {![info exists localCollectionPasswordArray($index)] || \
[string equal {} $localCollectionPasswordArray($index)]} {
# new local collection using static IP - register the localCollectionPassword
# registry is important because a local collection may become using dynamic IP in the future
set localCollectionPasswordArray($index) $localCollectionPassword
StoreArrayWithBackup localCollectionPasswordArray $col/$loBiMiRep/auxdoc/localCollectionPasswordArray.tcl w list
}
}
}
# Inclusion confirmation - end
} else {
set staticIPFlag {} ;# added by GJFB in 2018-05-25 - force staticIPFlag to empty (used in MultipleSubmit)
}
# siteList
LoadWithBackup $col/$loBiMiRep/doc/@siteList.txt fileContent
set fileContent [string trim $fileContent " \t\n"] ;# drop leading and trailing blank lines
regsub -all "\n+" $fileContent "\n" fileContent
set siteList [split $fileContent \n]
# if $unpostFlag {set staticIPFlag {}} ;# added by GJFB in 2010-09-20 - the collection is being unposted - force staticIPFlag to empty (used in MultipleSubmit) - commented by GJFB in 218-05-25 (now above)
set flag 1 ;# siteList must be updated to include a new local collection
set siteList2 {}
foreach siteRepIp2 $siteList {
# index2
set index2 [lindex $siteRepIp2 1] ;# remote loCoInRep in @siteList.txt of the resolver
if [string equal $index2 $index] {
# update
set agencyResolverAddress2 [lindex $siteRepIp2 6] ;# remote agencyResolverAddress in @siteList.txt of the resolver - added by GJFB in 2017-02-20 - part of the agency structure code
set siteRepIp [lreplace $siteRepIp 6 6 $agencyResolverAddress2] ;# maintain the agencyResolverAddress value contained in @siteList.txt - added by GJFB in 2017-02-20 - part of the agency structure code
lappend siteList2 [concat $siteRepIp $staticIPFlag] ;# added by GJFB in 2010-08-14
set flag 0
} else {
# let unchange
lappend siteList2 $siteRepIp2
}
}
if $flag {
# add
# if $unpostFlag #
if 0 {
# the index should be previously registered - abnormal state
# added by GJFB in 2013-06-29 in order to avoid adding a new entry at unpost - sometimes at unpost the URLib server is in an abnormal state (in this case it has been observed that siteRepIpConfirmation above contains outputs of GetMetadataRepositories before the expected value)
StoreLog alert UpdateSiteList "unexpected value for siteRepIpConfirmation: $siteRepIpConfirmation"
} else {
# the index was not previously registered
lappend siteList2 [concat $siteRepIp $staticIPFlag] ;# added by GJFB in 2010-08-14
set agencyResolverAddress2 [lindex $siteRepIp 6] ;# the agencyResolverAddress value defined at installation of the remote Archive - added by GJFB in 2017-02-20 - part of the agency structure code
}
}
set fileContent2 [join $siteList2 \n]
# SAVE
StoreWithBackup fileContent2 $col/$loBiMiRep/doc/@siteList.txt
# return $staticIPFlag ;# added by GJFB in 2010-08-23 - commented by GJFB in 2017-02-20
# puts [list $staticIPFlag $agencyResolverAddress2]
return [list $staticIPFlag $agencyResolverAddress2] ;# added by GJFB in 2017-02-20 - part of the agency structure code
}
## set loCoInRep dpi.inpe.br/banon/1999/01.09.22.14
# set loBiMiRep dpi.inpe.br/banon/1999/06.19.17.00
# set addr 200.210.103.243
# set col ../../../../..
# source cgi/mirrorfind-.tcl
# source utilities1.tcl
## source utilities2.tcl
# UpdateSiteList [list ntserver.iconet.com.br:1905 iconet.com.br/banon/2000/10.18.19.50 200.210.103.243 {2000:03.25.23.09.12 dpi.inpe.br/banon/1999/01.09.22.14} banon@iconet.com.br]
# UpdateSiteList - end
# ----------------------------------------------------------------------
# GetSiteList
# used in change.tcl
proc GetSiteList {input} {
global loBiMiRep
global col
if {[Compress $input] == "les.livres.sont.nos.amis"} {
Load $col/$loBiMiRep/doc/@siteList.txt fileContent
set fileContent [string trim $fileContent " \n"]
regsub -all "\n+" $fileContent "\n" fileContent
set siteList [split $fileContent \n]
} else {
set siteList {}
}
return $siteList
}
# GetSiteList - end
# ----------------------------------------------------------------------
# TestExecute
proc TestExecute {x} {
# global TestExecute
# after 10000 {set TestExecute 1}
# vwait TestExecute
return $x
}
# TestExecute - end
# ----------------------------------------------------------------------
# GetSiteStamp
# used in InformURLibSystem and TransferCopyright only
proc GetSiteStamp {} {
global col
global URLibServiceRepository
global loCoInRep
global environmentArray
global serverAddress
# set serverAddress [GetServerAddress] ;# could be drop using global serverAddress
set ip $environmentArray(ipAddress)
Load $col/$URLibServiceRepository/service/history history
set lastUpdate [lindex [lindex $history end] 0] ;# just date
set administratorEMailAddress $environmentArray(spMailEntry)
set archiveProtocol USP ;# USP (URlibService Protocol) or HTTP (Hypertext Transfer Protocol)
LoadService $loCoInRep agencyResolverAddress agencyResolverAddress 1 1 ;# added by GJFB in 2017-02-20 - part of the agency structure code
# return [list $serverAddress $loCoInRep $ip $archiveProtocol $lastUpdate $administratorEMailAddress] ;# commented by GJFB in 2017-02-20
return [list $serverAddress $loCoInRep $ip $archiveProtocol $lastUpdate $administratorEMailAddress $agencyResolverAddress] ;# added by GJFB in 2017-02-20 - part of the agency structure code
}
# GetSiteStamp
# ----------------------------------------------------------------------
# ReturnConfirmation
# used in UpdateSiteList and Script (urlib.net/www/2014/03.16.03.40) only
proc ReturnConfirmation {} {
return {confirmation yes} ;# could be anything but not empty
}
# ReturnConfirmation
# ----------------------------------------------------------------------
# InformURLibSystem
# Used in:
# post
# SPDialog (SPDialog.tcl)
# unpostFlag value is 0 or 1; 1 means that the local collection is beeing unposted
proc InformURLibSystem {{unpostFlag 0}} {
# runs with post
global homePath
global URLibServiceRepository
global serverAddress ;# set in LoadGlobalVariables
# global serverAddressWithIP ;# set in LoadGlobalVariables
global urlibServerAddress ;# set in LoadGlobalVariables
global loCoInRep
global loBiMiRep
# global staticIPFlag ;# set in this procedure - used in CreateEnvironmentArray (see StartServer.tcl) MakeRepository
global staticIPFlag ;# set in this procedure - used in MakeRepository (see DDDialog.tcl) and CreateFullEntry (see utilitiesMirror.tcl)
global environmentArray ;# changed temporarily in this procedure
global installInitialCollection ;# set in LoadGlobalVariables
global ipChangeFlag ;# set in post
global resolverIndexRepository ;# added by GJFB in 2017-12-21 to identify if the URLibService is running or not the urlib.net resolver
if [file exists $homePath/readOnlySite] {return}
# if {[string equal $serverAddress $urlibServerAddress] || [string equal www.$serverAddress $urlibServerAddress]} {return 1} - commented by GJFB in 2017-12-21
if [string equal $resolverIndexRepository $loCoInRep] {return 1} ;# added by GJFB in 2017-12-21
# about the file $homePath/@informURLibSystemFlag
# the file $homePath/@informURLibSystemFlag is created or removed manually only
# it is used when creating a copy of a local collection on a new host and the post command is run for testing on this new host
# this is useful when preparing a local collection migration between hosts
# the contain of $homePath/@informURLibSystemFlag is 0 or 1
# 1 must be used when the host has a static IP otherwise 0 must be used
# after migration the file $homePath/@informURLibSystemFlag must removed
if [file exists $homePath/@informURLibSystemFlag] { ;# added by GJFB in 2018-10-14 - to prepare a local collection migration between hosts
Load $homePath/@informURLibSystemFlag informURLibSystemFlag
set log "the local collection which index is $loCoInRep is a copy of an original local collection, its staticIPFlag was set to $informURLibSystemFlag (see $homePath/@informURLibSystemFlag file)"
puts [StoreLog {warning} {InformURLibSystem (1)} $log]
return $informURLibSystemFlag
}
# not the resolver urlib.net
if 0 {
# not used
# localCollectionPassword
if ![file exists $homePath/col/$URLibServiceRepository/auxdoc/localCollectionPassword] {
# localCollectionPassword file doesn't exist
regsub {0\.} [expr [SortRandomNumber]/double(233280)] {} localCollectionPassword
set data [Shift $loCoInRep $localCollectionPassword]
Store data $homePath/col/$URLibServiceRepository/auxdoc/localCollectionPassword binary 1
} else {
# localCollectionPassword file already exists
Load $homePath/col/$URLibServiceRepository/auxdoc/localCollectionPassword data binary
set data [UnShift $data]
set localCollectionPassword [lindex $data end]
}
}
if 0 {
# commented by GJFB in 2017-10-15 - now below - loCoInRep is not known at installation
if [LoadService $loCoInRep registrationPassword registrationPassword 1 1] {
# corrupted password
set log "\[[clock format [clock seconds] -format %Y:%m.%d.%H.%M.%S]\] InformURLibSystem (1): $loCoInRep has a corrupted registration password\n"
puts $log
Store log $homePath/@errorLog auto 0 a
return
}
}
# puts "Registration key for $loCoInRep: $registrationPassword" ;# useful to register an Archive within the IBI resoltion system
set environmentArrayFlag [info exists environmentArray(sitesHavingReadPermission)]
if $environmentArrayFlag {
set sitesHavingReadPermission $environmentArray(sitesHavingReadPermission)
set environmentArray(sitesHavingReadPermission) {{Main Site}} ;# to allow confirmation of the output of GetSiteStamp by urlib.net (see UpdateSiteList) - otherwise UpdateSiteList might return 0 even for static IP (for example, when sitesHavingReadPermission is {{No Sites}}). In this case the domain name will be set to empty.
}
if $installInitialCollection {
set staticIPFlag 0
} else {
if [LoadService $loCoInRep registrationPassword registrationPassword 1 1] { ;# added by GJFB in 2017-10-15 - loCoInRep is not known at installation
# corrupted password
# set log "\[[clock format [clock seconds] -format %Y:%m.%d.%H.%M.%S]\] InformURLibSystem (1): $loCoInRep has a corrupted registration password\n"
# puts $log
# Store log $homePath/@errorLog auto 0 a
set log "$loCoInRep has a corrupted registration password"
puts [StoreLog {alert} {InformURLibSystem (2)} $log]
return
}
set siteStamp [GetSiteStamp]
# MULTIPLE SUBMIT
# UPDATESITELIST
# set staticIPFlag {} ;# reply of MultipleSubmit - must be global
if 0 {
# using USP (URLibService protocol)
set query [list list UpdateSiteList $siteStamp $registrationPassword $unpostFlag] ;# added by GJFB in 2010-09-20
# puts $query
if 0 {
set staticIPFlag {} ;# reply of MultipleSubmit - must be global
MultipleSubmit {} $query staticIPFlag 1 [list {www.urlib.net 800}] ;# used to update auxdoc/localCollectionPasswordArray.tcl and doc/@siteList.txt
} else {
# added by GJFB in 2012-12-19 to avoid using MultipleSubmit with empty pid
# set staticIPFlag [MultipleExecute [list {www.urlib.net 800}] $query 1] ;# scenario 1 - commented by GJFB in 2017-02-20
foreach {staticIPFlag agencyResolverAddress} [MultipleExecute [list {www.urlib.net 800}] $query] {break} ;# default scenario 0 - added by GJFB in 2017-02-20 - part of the agency structure code
# set staticIPFlag [MultipleExecute [list {gjfb.home 800}] $query 1]
# set staticIPFlag [Execute {gjfb 800} [list UpdateSiteList [GetSiteStamp] $registrationPassword $unpostFlag]]
}
} else {
# using HTTP
package require http ;# see online manual
# Convert URLibServive format to norm format
# communication scheme step 2
# set siteStampListForArray [ConvertSimpleListToListForArray {archiveaddress archiveserviceibi archiveip archiveprotocol archiveplatformversion archiveadmemailaddress} $siteStamp] ;# commented by GJFB in 2017-02-20
set siteStampListForArray [ConvertSimpleListToListForArray {archiveaddress archiveserviceibi archiveip archiveprotocol archiveplatformversion archiveadmemailaddress agencyresolveraddress} $siteStamp] ;# added by GJFB in 2017-02-20 - part of the agency structure code
if $unpostFlag {
set queryList servicesubject=exclusionRequest
} else {
set queryList servicesubject=inclusionRequest
}
foreach {name value} $siteStampListForArray {
lappend queryList $name=$value
}
foreach {name value} $siteStampListForArray {
if {$installInitialCollection && [string equal archiveserviceibi $name]} {
lappend queryList $name= ;# added by GJFB in 2016-04-28 - value of archiveserviceibi (loCoInRep) is empty at installation (loCoInRep is unknown before installation)
} else {
lappend queryList $name=$value
}
}
lappend queryList registrationkey=$registrationPassword ;# used in UpdateSiteList - should be encrypted
set queryString [join $queryList &]
# Convert URLibServive format to norm format - end
# set site2 www.urlib.net
set site2 [ReturnHTTPHost $urlibServerAddress] ;# www.urlib.net
# set site2 gjfb.home
# puts http://$site2/J8LNKB5R7W/3FUQHC5?$queryString
# =>
# http://www.urlib.net/J8LNKB5R7W/3FUQHC5?servicesubject=inclusionRequest&archiveaddress=gjfb.home+800&archiveserviceibi=dpi.inpe.br/banon/1999/01.09.22.14&archiveip=192.168.1.31&archiveprotocol=USP&archiveplatformversion=2014:10.04.01.25.28&archiveadmemailaddress=gerald.banon@gmail.com®istrationkey=896322016461
# http://www.urlib.net/J8LNKB5R7W/3FUQHC5?servicesubject=inclusionRequest&archiveaddress=gjfb.home+800&archiveserviceibi=dpi.inpe.br/banon/1999/01.09.22.14&archiveip=192.168.1.31&archiveprotocol=USP&archiveplatformversion=2014:10.04.01.25.28&archiveadmemailaddress=gerald.banon@gmail.com®istrationkey=896322016461&agencyresolveraddress=
# http://www.urlib.net/J8LNKB5R7W/3FUQHC5?servicesubject=exclusionRequest&archiveaddress=gjfb.home+800&archiveserviceibi=dpi.inpe.br/banon/1999/01.09.22.14&archiveip=192.168.1.31&archiveprotocol=USP&archiveplatformversion=2014:10.04.01.25.28&archiveadmemailaddress=gerald.banon@gmail.com®istrationkey=896322016461
# http://gjfb:1905/J8LNKB5R7W/3FUQHC5?servicesubject=exclusionRequest&archiveaddress=gjfb.home+800&archiveserviceibi=dpi.inpe.br/banon/1999/01.09.22.14&archiveip=192.168.1.31&archiveprotocol=USP&archiveplatformversion=2014:10.04.01.25.28&archiveadmemailaddress=gerald.banon@gmail.com®istrationkey=896322016461&agencyresolveraddress=
# J8LNKB5R7W/3FUQHC5 == Resolver service for IBI archive registration
# include Archive (2)
# exclude Archive (7)
if [catch {http::geturl [ConvertURLToHexadecimal http://$site2/J8LNKB5R7W/3FUQHC5?$queryString 1]} token] {
# puts --$token--
set staticIPFlag {} ;# no response
} else {
# geturl returned
if [string equal {404} [::http::ncode $token]] {
# not found
# puts {not found}
set staticIPFlag {} ;# no response
} else {
# puts OK
set resolverResponse [string trimright [http::data $token]]
# puts --$resolverResponse-- ;# >>> resolverResponse may content an error message
if [regexp {^<(.*)>$} $resolverResponse m errorMessage] {
# set log "\[[clock format [clock seconds] -format %Y:%m.%d.%H.%M.%S]\] InformURLibSystem (2): $errorMessage\n"
# puts $log
# Store log $homePath/@errorLog auto 0 a
set log "$errorMessage"
puts [StoreLog {error} {InformURLibSystem (3)} $log]
set staticIPFlag {}
} else {
set {responseArray(nothing to return)} {nothing to return}
if [catch {array set responseArray $resolverResponse}] { ;# added by GJFB in 2016-04-02
# list element in quotes followed by ":" instead of space
# puts --$resolverResponse-- ;# >>> resolverResponse may content an error message
# => can't read "responseArray({})": no such element in array
set staticIPFlag {} ;# no response - urlib.net need to be reposted, it returns "error writing "sock7": broken pipe"
} else {
ConditionalSet archiveStatus responseArray(status.archive) {}
ConditionalSet confirmationStatus responseArray(status.confirmation) {}
set staticIPFlag {}
if [string equal {included} $archiveStatus] {
set staticIPFlag [string equal {successful} $confirmationStatus] ;# 0 (dynamic IP), 1 (static IP) or empty (not registered, wrong key or unposted)
ConditionalSet agencyResolverAddress responseArray(agencyresolveraddress) {} ;# agencyresolveraddress is optional - added by GJFB in 2017-02-20 - part of the agency structure code
if [string equal {} $agencyResolverAddress] {
file delete $homePath/col/$loCoInRep/service/agencyResolverAddress
} else {
StoreService agencyResolverAddress $loCoInRep agencyResolverAddress 1 1 ;# added by GJFB in 2017-02-20 - part of the agency structure code - the value of agencyResolverAddress is stored in service/agencyResolverAddress but at the moment this (updated) value is not used by the URLibService
}
# Inform the agency resolver as well
if {![string equal {} $agencyResolverAddress] && ![string equal [ReturnHTTPHost $serverAddress] $agencyResolverAddress]} {
if ![catch {http::geturl [ConvertURLToHexadecimal http://$agencyResolverAddress/J8LNKB5R7W/3FUQHC5?$queryString 1]} token] { ;# added by GJFB in 2017-02-20 - part of the agency structure code
# geturl returned
http::cleanup $token
}
}
# Inform the agency resolver as well - end
}
}
}
}
# puts --[::http::data $token]--
# puts --[::http::code $token]--
# puts --[::http::status $token]--
# puts --[::http::error $token]--
http::cleanup $token
}
} ;# using HTTP - end
}
# puts --$staticIPFlag--
if $environmentArrayFlag {set environmentArray(sitesHavingReadPermission) $sitesHavingReadPermission} ;# restore the original permission (if any)
if {![string equal {} $staticIPFlag] || $ipChangeFlag || ![info exists environmentArray(staticIPFlag)]} { ;# added by GJFB in 2017-04-28 avoiding MakeRepository to crash when urlib.net is down (otherwise we would get a "Submission NOT completed..." message
set environmentArray(staticIPFlag) $staticIPFlag ;# added by GJFB in 2014-10-29 - used in MakeRepository only (when MakeRepository runs with start)
} else {
# staticIPFlag is empty and ipChangeFlag is 0 (no ip change) and environmentArray(staticIPFlag) exists
# leave environmentArray(staticIPFlag) as it is because urlib.net may be down when running post (in this case staticIPFlag is empty and MakeRepository crashes)
}
return $staticIPFlag ;# added by GJFB in 2010-08-23
}
# InformURLibSystem - end
# ----------------------------------------------------------------------
# GetAuthor
# comma value is {,} or {}
# {} is used in the BibINPE format
# example:
# with comma == {,}
# GetAuthor returns: Banon, G. J. F.,
# with comma == {}
# GetAuthor returns: Banon, G. J. F.
# nameFormat value is short, familynamefirst or familynamelast
# (used by CreateBriefTitleAuthorEntry)
proc GetAuthor {rep-i {level {#0}} {comma {,}} {nameFormat {short}}} {
global referRepository
global ${referRepository}::conversionTable
upvar $level metadataArray metadataArray
if {$level != "#0"} {set level [expr $level + 1]}
set type [ReturnType metadataArray ${rep-i} $level]
if [info exists metadataArray(${rep-i},$conversionTable($type,%A))] {
set authorList $metadataArray(${rep-i},$conversionTable($type,%A))
} else {
return
}
return [FormatAuthorName $authorList $comma $nameFormat]
}
# GetAuthor - end
# ----------------------------------------------------------------------
# CapitalizeLastName
# comma value is {,} or {}
# {} is used in the BibINPE format
# example:
# with comma == {,}
# CapitalizeLastName returns: BANON, Gerald Jean Francis,
# with comma == {}
# CapitalizeLastName returns: BANON, Gerald Jean Francis
proc CapitalizeLastName {authorList {comma {}}} {
set authorList2 {}
foreach author $authorList {
regsub {,$} $author {} author
if [regexp {(.*),(.*)} $author m lastName otherNames] {
lappend authorList2 "[string toupper $lastName], $otherNames$comma"
} else {
lappend authorList2 "[string toupper $author]$comma"
}
}
return $authorList2
}
# CapitalizeLastName - end
# ----------------------------------------------------------------------
# LoadServiceData
# Examples:
# LoadServiceData $rep contenttype type type
# LoadServiceData $rep lastupdate history history
# service -> repositoryProperties array
proc LoadServiceData {rep fieldName fileName indexName} {
# runs with post
global col
global repositoryProperties
if [file exists $col/$rep/service/$fileName] {
if [regexp {^username|^hostcollection|^mirrorsites|^docremotepermission|^downloadremotepermission} $fieldName] {
LoadService $rep $fileName fileContent 1 1
} else {
Load $col/$rep/service/$fileName fileContent
}
set fileContent [string trim $fileContent \n]
if {$fileContent == {}} {
if [info exists repositoryProperties($rep,$indexName)] {
unset repositoryProperties($rep,$indexName)
}
file delete $col/$rep/service/$fileName
} else {
# puts "$indexName = $fileContent"
set repositoryProperties($rep,$indexName) $fileContent
}
} else {
if [info exists repositoryProperties($rep,$indexName)] {
unset repositoryProperties($rep,$indexName)
}
}
}
# LoadServiceData - end
# ----------------------------------------------------------------------
# UpdateRepositoryProperties
# Update properties in repositoryProperties from the files in the
# service directory
# field value is all (default) or a field name (e.g., hostcollection)
# all means update all fields
# if rep doesn't exists the data are deleted
#
# field names examples:
# targetfile, lastupdate, contenttype, hostcollection,
# size, numberoffiles, copyright, docpermission,
# downloadpermission, language, mirrorsites,
# docremotepermission, downloadremotepermission,
# authenticatedusers, username
#
# service -> repositoriesProperties array
proc UpdateRepositoryProperties {rep {field {all}}} {
# runs with post
global fieldNameArray ;# set in LoadGlobalVariables
if {$rep == {}} {return}
if {$field == "all"} {
foreach field [array names fieldNameArray] {
eval "LoadServiceData $rep $fieldNameArray($field)"
# LoadServiceData $rep $fieldNameArray($field)
}
} else {
eval "LoadServiceData $rep $fieldNameArray($field)"
# LoadServiceData $rep $fieldNameArray($field)
}
}
# UpdateRepositoryProperties - end
# ----------------------------------------------------------------------
# GetTargetFile
proc GetTargetFile {rep} {
# runs with post
global repositoryProperties
set rep2 [string tolower $rep] ;# rep is case-insensitive
if [info exists repositoryProperties($rep2,targetfile)] {
set targetFile $repositoryProperties($rep2,targetfile)
} elseif [info exists repositoryProperties($rep,targetfile)] {
# dpi.inpe.br/Gemini and sid.inpe.br/MTC-m13 are exceptions
set targetFile $repositoryProperties($rep,targetfile)
} else {
set targetFile {}
}
return $targetFile
}
# GetTargetFile - end
# ----------------------------------------------------------------------
# GetEncodingName
proc GetEncodingName {} {
return [encoding system]
}
# GetEncodingName - end
# ----------------------------------------------------------------------
# GetAuthorHomePage
proc GetAuthorHomePage {rep} {
global repositoryProperties
if [info exists repositoryProperties($rep,authorhomepage)] {
set authorHomePage $repositoryProperties($rep,authorhomepage)
} else {
set authorHomePage {}
}
return $authorHomePage
}
# GetAuthorHomePage - end
# ----------------------------------------------------------------------
# GetCitedRepositoryList
# Return the list of cited repositories in the document
# contained in $rep
# flag value is 0, 1 or 2
# 0 means to return all
# 1 means to exclude the cited copyright repositories
# 2 means to return just the first (if any) mirror repository (used in CreatePage)
# extrated from the referenceTable array
# GetCitedRepositoryList is NOT RECURSIVE
# repository name must NOT contain comma (see regsub below)
proc GetCitedRepositoryList {rep {flag 0}} {
# runs with post
global referenceTable
set indexList [array names referenceTable $rep,*]
if $flag {
set citedRepositoryList {}
if {$flag == 1} {
# exclude the cited copyright repositories
foreach index $indexList {
regsub {.*,} $index {} citedRep
if {![TestContentType $citedRep {Copyright}] && \
![TestContentType $citedRep {Local Copyright}]} {
lappend citedRepositoryList $citedRep
}
}
}
if {$flag == 2} {
# return just the first mirror repository
foreach index $indexList {
regsub {.*,} $index {} citedRep
if [TestContentType $citedRep {Mirror}] {
set citedRepositoryList $citedRep
break
}
}
}
} else {
# return all
regsub -all { [^,]*,} " $indexList" { } citedRepositoryList
set citedRepositoryList [string trimleft $citedRepositoryList]
}
return $citedRepositoryList
}
# GetCitedRepositoryList - end
# ----------------------------------------------------------------------
# GetCitingRepositoryList
# Return the list of citing repositories in the document
# contained in $rep (including metadata repositories)
proc GetCitingRepositoryList {rep} {
# runs with post
global referenceTable
set indexList [array names referenceTable *,$rep]
set citingRepositoryList {}
foreach index $indexList {
regsub {,.*} $index {} citingRep
lappend citingRepositoryList $citingRep
}
return $citingRepositoryList
}
# GetCitingRepositoryList - end
# ----------------------------------------------------------------------
# GetCitingRepositoryList-
# Return the list of citing repositories in the document
# contained in $rep, excluding the metadata repositories
proc GetCitingRepositoryList- {rep entryWidget varName} {
# runs with start
set metadataRepList [FindMetadataRepList $rep $entryWidget $varName]
set list [Eval GetCitingRepositoryList $rep]
set citingRepositoryList {}
foreach citingRepository $list {
set break 0
foreach metadataRep $metadataRepList {
if {[string compare $citingRepository $metadataRep] == 0} {
set break 1
break
}
}
if !$break {lappend citingRepositoryList $citingRepository}
}
return $citingRepositoryList
}
# GetCitingRepositoryList- - end
# ----------------------------------------------------------------------
# FindPreferredLanguage
# finds the available translations of the firstLanguageRep
# returns the language in languageButton if this language is among the available translations of the firstLanguageRep
# otherwise it returns the preferred language (usually based on the browser language preference given in languagePreference) if this language is among the available translations of the firstLanguageRep
# otherwise it returns the language of the firstLanguageRep
# i.e., when languageButton is not empty and is among the available translations of the firstLanguageRep it has priority over the preferred language
# used in FindLanguage and FindLanguageForSubmissionForm (utilities1.tcl)
# fileName is the target file without the language prefix
# Example: filName is Index.html for the target files enIndex.html, pt-BRIndex.html, ...
# or FillingInstructions.tcl (previously, Submit.html) for the target files enFillingInstructions.tcl,
# pt-BRFillingInstructions.tcl, ...
# languageButton value is en, pt-BR ...
# languagePreference is for example, using env(HTTP_ACCEPT_LANGUAGE): pt-br,en;q=0.5
proc FindPreferredLanguage {firstLanguageRep fileName languagePreference languageButton} {
# runs with post
global referenceTable
global repositoryProperties
set languageRepList {}
# Find the language of the firstLanguageRep
if [info exists repositoryProperties($firstLanguageRep,targetfile)] {
set targetFile $repositoryProperties($firstLanguageRep,targetfile)
if [regexp "(.*)$fileName" $targetFile m firstLanguage] {
set languageRepList [list $firstLanguage $firstLanguageRep]
} else {
if 0 {
# Migration 12/11/04
if {[string compare FillingInstructions.tcl $fileName] == 0} {
if [regexp "(.*)Submit\.html" $targetFile m firstLanguage] {
set languageRepList [list $firstLanguage $firstLanguageRep]
}
}
# Migration 12/11/04 - end
}
}
}
# Find the language of the firstLanguageRep - end
# Explore the child repositories of the firstLanguageRep
foreach index [array names referenceTable *,$firstLanguageRep] {
regsub {,.*} $index {} rep
if [info exists repositoryProperties($rep,targetfile)] {
set targetFile $repositoryProperties($rep,targetfile)
if [regexp "(.*)$fileName" $targetFile m language] {
if {[info exists firstLanguage] && [string compare $firstLanguage $language] == 0} {continue}
set languageRepList [concat $languageRepList [list $language $rep]]
} else {
if 0 {
# Migration 12/11/04
if {[string compare FillingInstructions.tcl $fileName] == 0} {
if [regexp "(.*)Submit\.html" $targetFile m language] {
if {[info exists firstLanguage] && [string compare $firstLanguage $language] == 0} {continue}
set languageRepList [concat $languageRepList [list $language $rep]]
}
}
# Migration 12/11/04 - end
}
}
}
}
# Explore the child repositories of the firstLanguageRep - end
if {$languageRepList == ""} {return [list {} {}]} ;# may cause problem (e.g., with sendMail.php)
# languageRepArray
array set languageRepArray $languageRepList
# puts [array names languageRepArray]
# => pt-BR en
set language [lindex $languageRepList 0] ;# first language
# if {![string equal {} $languageButton] && [lsearch -exact [array names languageRepArray] $languageButton] != -1} #
# set language $languageButton
# new code added by GJFB in 2012-06-29 to convert pt into pt-BR
if {![string equal {} $languageButton] && [set i [lsearch -regexp [array names languageRepArray] ^$languageButton]] != -1} {
set language [lindex [array names languageRepArray] $i]
} elseif {$languagePreference != ""} {
foreach preferredLanguage [split $languagePreference ,] {
set preferredLanguage [lindex [split $preferredLanguage \;] 0] ;# pt-br
regexp {(..)(.*)} $preferredLanguage m a b
set preferredLanguage $a[string toupper $b] ;# pt-br -> pt-BR
if {[lsearch -exact [array names languageRepArray] $preferredLanguage] != -1} {
set language $preferredLanguage
break
}
}
}
set languageRep $languageRepArray($language)
return [list $language $languageRep]
}
# FindPreferredLanguage - end
# ----------------------------------------------------------------------
# FindLanguageRepList
# Find the available translations of the firstLanguageRep
# Used in FindLanguage (utilities1.tcl)
# fileName is the target file without the language prefix
# Example: filName is Form.html for the target files enForm.html,
# pt-BRForm.html, ...
# not used
proc FindLanguageRepList {firstLanguageRep fileName} {
global referenceTable
global repositoryProperties
set languageRepList ""
if {[info exists repositoryProperties($firstLanguageRep,targetfile)] && \
[regexp "(.*)$fileName" \
$repositoryProperties($firstLanguageRep,targetfile) \
m language]} {
set languageRepList [list $language $firstLanguageRep]
}
foreach index [array names referenceTable *,$firstLanguageRep] {
regsub {,.*} $index {} rep
if {[info exists repositoryProperties($rep,targetfile)] && \
[regexp "(.*)$fileName" \
$repositoryProperties($rep,targetfile) \
m language]} {
set languageRepList [concat $languageRepList \
[list $language $rep]]
}
}
return $languageRepList
}
# FindLanguageRepList - end
# ----------------------------------------------------------------------
# CheckMetadataConsistency
# Check the metadata consistency with the file system
# (just for a short list of metadata - less than $maximumNumberOfEntries)
# used by StartService, FindMetadataRep and RemoveRepository
# rep-iListName is a list of metadata repositories
# simplyfied version - effective just for missing repositories
proc CheckMetadataConsistency {rep-iListName {maximumNumberOfEntries 1}} {
# runs with post
global col
global homePath
global metadataArray
global loCoInRep
# global serverAddress
global deletedRepositoryList
global deletedIdentifierList
upvar ${rep-iListName} rep-iList
# set xxx ${rep-iList}
# Store xxx C:/tmp/bbb.txt auto 0 a
# set xxx [CallTrace]
# puts $xxx
# Store xxx C:/tmp/bbb.txt auto 0 a
set update 0
if {[llength ${rep-iList}] <= "$maximumNumberOfEntries"} {
## site
## set site [GetServerAddress]
# set site $serverAddress
set list {}
set metadataList {} ;# for add
set metadata2List {} ;# for remove
set removeOnly 0
foreach rep-i ${rep-iList} {
# regsub -- {-[^-]*$} ${rep-i} {} metadataRep
regexp {(.*)-([^-]*)$} ${rep-i} m metadataRep i ;# i not used
if ![file isdirectory $col/$metadataRep] {
# the metadata repository has been deleted
# the deletedRecord argument is needed because insertionOn- may be already in use
# when CheckMetadataConsistency is called
# Waiting for the completion of other authentications
WaitQueue CheckMetadataConsistency deletedRecord
# Waiting for the completion of other authentications - end
set metadata2List [concat $metadata2List [GetMetadata $metadataRep-*]] ;# extract from the global array: metadataArray
# Transient deleted record
# if [info exists metadataArray(${rep-i},hostcollection)] #
if [ReturnState ${rep-i}] {
# just the repositories containing an original document are considered
if [file exists $col/$loCoInRep/doc/@deletedRecordList.tcl] {
source $col/$loCoInRep/doc/@deletedRecordList.tcl ;# set deletedRecordList - used with OAI-PMH only (see iconet.com.br/banon/2003/11.21.21.08)
} else {
set deletedRecordList {}
}
# metadataLastUpdate
set metadataLastUpdate [lindex [CreateVersionStamp [clock seconds]] 0]
if {[lsearch -exact $deletedRecordList $metadataRep-0] == -1} {
# not found
lappend deletedRecordList $metadataRep-0 $metadataLastUpdate
# STORE
StoreArray deletedRecordList $col/$loCoInRep/doc/@deletedRecordList.tcl w list listforarray 1
}
set storeFlag 0 ;# don't store
if [info exists metadataArray(${rep-i},repository)] {
set repository $metadataArray(${rep-i},repository)
if ![file isdirectory $col/$repository] {
if {[lsearch -exact $deletedRepositoryList $repository] == -1} {
# not found
lappend deletedRepositoryList $repository $metadataLastUpdate
set storeFlag 1 ;# store
}
}
}
if {[lsearch -exact $deletedRepositoryList $metadataRep] == -1} {
# not found
lappend deletedRepositoryList $metadataRep $metadataLastUpdate
set storeFlag 1 ;# store
}
# STORE
if $storeFlag {StoreArray deletedRepositoryList $col/$loCoInRep/doc/@deletedRepositoryList.tcl w list listforarray 1}
if [info exists metadataArray(${rep-i},identifier)] {
set identifier $metadataArray(${rep-i},identifier)
if {[lsearch -exact $deletedIdentifierList $identifier] == -1} {
# not found
lappend deletedIdentifierList $identifier $metadataLastUpdate
# STORE
StoreArray deletedIdentifierList $col/$loCoInRep/doc/@deletedIdentifierList.tcl w list listforarray 1
}
}
}
# Transient deleted record - end
set rep [ReturnRepositoryName $metadataRep]
UpdateVariables $rep ;# discard from repositoryProperties and referenceTable
UpdateVariables $metadataRep ;# discard from repositoryProperties and referenceTable
set update 1
LeaveQueue [pid] deletedRecord
} else {
# the metadata repository exists
lappend list ${rep-i}
}
}
if $update {
# Update metadata
# puts {updating...}
RemoveMetadata $metadata2List 1
# Update metadata - end
}
set rep-iList $list
} else {
# set list ${rep-iList}
}
# return [list $list $update]
return $update
}
# CheckMetadataConsistency - end
# ----------------------------------------------------------------------
# UpdateReferenceTable
# updates references
# service/reference is a fileName for a file containing the patterns
# (starting from doc) like xxx.tcl or *.html
# of files that may contain relative links to other repositories
# or a proper relative link
# example of service/reference file content:
# ../../../../../../col/dpi.inpe.br/banon/1999/10.31.20.32
# xxx.tcl
# *.html
# discard value is 0 or 1
# 1 means to discard any old references in rep (i.e, the parent repositories)
# 0 means to doesn't discard (used only when we know that there is no
# old reference in rep)
# if rep doesn't exists the data are deleted (discard must be 1)
# service -> referenceTable
proc UpdateReferenceTable {rep {discard 1}} {
# runs with post
global referenceTable
global homePath
global col
global pwd
global loCoInRep
# set xxx [CallTrace]
# Store xxx C:/tmp/aaa auto 0 a
# the references may be old and must be discarded
if $discard {DiscardRepository $rep referenceTable}
if ![file isdirectory $homePath/col/$rep] {return}
if 0 {
# not used anymore since 2009-07-16
# process copyright data
if [file exists $homePath/col/$rep/service/copyright] {
Load $homePath/col/$rep/service/copyright copyright
foreach repName $copyright {
set referenceTable($rep,$repName) 1
}
}
}
# process reference data
if [file exists $homePath/col/$rep/service/reference] {
set fileList {}
Load $homePath/col/$rep/service/reference reference
# set reference [string trim $reference \n]
foreach line [split $reference \n] {
if [regexp {^../} $line] {
# called repository in the reference file
# examples:
# ../../../../../../col/dpi.inpe.br/banon/1999/10.31.20.32
# ../../../../../../col/iconet.com.br/banon/2001/02.10.22.55 +
# + indicates that rep is a translation of the calledRep (here iconet.com.br/banon/2001/02.10.22.55)
if [regexp \
"../$col/col/(\[^/\]*/\[^/\]*/\[^/\]*/\[^/ \]*).*$" $line m calledRep] {
if {[llength $m] == 2} {
set value [lindex $m 1] ;# +
} else {
set value 1
}
set referenceTable($rep,$calledRep) $value
} else {
if [TestContentType $rep Metadata] {
# the link to the repository containing the document has been corrupted
# it should be recreated
# 1
file delete $homePath/col/$rep/service/reference
if [CreateReferenceFile $rep] {
lappend message "UpdateReferenceTable (1) ([clock format [clock seconds]]): reference file not recreated"
lappend message "%4 field in $homePath/col/$rep/doc/@metadata.refer has been probably damaged"
lappend message [CallTrace]
set log [join $message \n]
puts $log
Store log $homePath/@errorLog auto 0 a
}
}
}
} else {
# the line contains a pattern to files to be searched
if [regexp {^ *\* *$} $reference] {
# * - get all the files below doc
set dir $homePath/col/$rep/doc
DirectoryContent fileList $dir $dir
} else {
if [TestContentType $rep Metadata] {
# the link to the repository containing the document has been corrupted
# it should be recreated
# 2
file delete $homePath/col/$rep/service/reference
if [CreateReferenceFile $rep] {
lappend message "UpdateReferenceTable (2) ([clock format [clock seconds]]): reference file not recreated"
lappend message "%4 field in $homePath/col/$rep/doc/@metadata.refer has been probably damaged"
lappend message [CallTrace]
set log [join $message \n]
puts $log
Store log $homePath/@errorLog auto 0 a
}
} else {
cd $homePath/col/$rep/doc
set fileList2 [glob -nocomplain -- $line]
cd $pwd
set fileList [concat $fileList $fileList2]
}
}
}
}
foreach file $fileList {
if [catch {open $col/$rep/doc/$file r} fileId] {
puts stderr $fileId
} else {
set fileContent [read $fileId]
foreach line [split $fileContent \n] {
if [regexp \
"../$col/col/(\[^/\]*/\[^/\]*/\[^/\]*/\[^/ >\]*)" $line m calledRep] {
set referenceTable($rep,$calledRep) 1
}
}
close $fileId
}
}
} else {
if [TestContentType $rep Metadata] {
# the link to the repository containing the document has been lost
# it should be recreated
# 3
if [CreateReferenceFile $rep] {
lappend message "UpdateReferenceTable (3) ([clock format [clock seconds]]): reference file not recreated"
lappend message "%4 field in $homePath/col/$rep/doc/@metadata.refer has been probably damaged"
lappend message [CallTrace]
set log [join $message \n]
puts $log
Store log $homePath/@errorLog auto 0 a
}
}
}
if 0 {
if ![info exists loCoInRep] {return} ;# installation time
if [TestContentType $rep Metadata] {
# establishes a virtual link between loCoInRep and rep
set referenceTable($loCoInRep,$rep) 1
}
}
}
# UpdateReferenceTable - end
# ----------------------------------------------------------------------
# DiscardRepository
# varName examples: repositoryProperties, referenceTable, ...
proc DiscardRepository {rep varName} {
upvar #0 $varName var
set flag 0
foreach index [array names var $rep,*] {
unset var($index)
set flag 1
}
return $flag
}
# DiscardRepository - end
# ----------------------------------------------------------------------
# UpdateMetadataBase
# (used with CheckMetadataConsistency and PerformCheck)
# updates metadata from repositoryProperties and @metadata.refer
# we assume that a UpdateRepositoryProperties for the metadata
# repository was done before
# on output, flag value 1 means that the metadata base must be updated
# (used only in CheckMetadataConsistency)
# service -> repositoryProperties -> metadataList
# site is the server address (e.g., banon-pc2 19050)
proc UpdateMetadataBase {metadataRep metadataListName metadata2ListName site flagName} {
# runs with post
global col
global metadataArray
global repositoryProperties
# global startApacheServer
upvar $metadataListName metadataList
upvar $metadata2ListName metadata2List
upvar $flagName flag
# puts [CallTrace]
# repName
set repName [ReturnRepositoryName $metadataRep]
UpdateRepositoryProperties $repName
UpdateReferenceTable $repName
if ![info exists repositoryProperties($repName,history)] {return}
# versionStamp for repName
# set history $repositoryProperties($repName,history)
# set repStamp [lindex $history end]
set repStamp [GetVersionStamp $repName]
if ![info exists repositoryProperties($metadataRep,history)] {return}
# versionStamp for metadataRep
# set history $repositoryProperties($metadataRep,history)
# set metadataRepStamp [lindex $history end]
set metadataRepStamp [GetVersionStamp $metadataRep]
if {![info exists metadataArray($metadataRep-0,lastupdate)] || \
![info exists metadataArray($metadataRep-0,metadatalastupdate)] || \
[GetLastUpdate $metadataRep-0] != "$repStamp" || \
$metadataArray($metadataRep-0,metadatalastupdate) != "$metadataRepStamp"} {
# Update metadata lists
Load $col/$metadataRep/doc/@metadata.refer fileContent
set metadataList [concat $metadataList [ConvertMultipleRefer2MetadataList 0 $fileContent $metadataRep]]
set metadataList [concat $metadataList [CreateExtraFields $metadataRep $site]]
set metadata2List [concat $metadata2List [GetMetadata $metadataRep-*]]
set flag 1
# Update metadata lists - end
}
}
# UpdateMetadataBase - end
# ----------------------------------------------------------------------
# FindCopyrightRepositories
# Finds the repositories containing the copyrights (in the first language)
# such repositories are:
# 1. the copyright repository of repName (defined in the file service/copyright) (if any)
# and the copyright repositories of PARENT repositories of repName (if any)
# 2. the local copyright repository (if any)
# 3. the default copyright warning repository
# used in Copyright only
proc FindCopyrightRepositories {repName language} {
# runs with post
global referenceTable
global repositoryProperties
global copyrightWarningRepository ;# Default copyright warning for the URLib collection
# global loCoInRep
global homePath
# 1.
# look for copyright repositories of repName and of its parents
set citedRepositoryList [CreateCitedRepositoryList $repName] ;# get the parent repositories recursively
# puts --$citedRepositoryList--
lappend citedRepositoryList $repName ;# include repName
# set copyrightRepositories {}
foreach citedRepository $citedRepositoryList {
if [file exists $homePath/col/$citedRepository/service/copyright] {
Load $homePath/col/$citedRepository/service/copyright copyrightRep
# Find copyright repository in the appropriate language
set siteRep [FindSite2 $copyrightRep 1 $language] ;# find rep in the appropriate language
# puts --$siteRep--
if {$siteRep == {}} {
# site not found
set appropriateCopyrightRep $copyrightRep
} else {
foreach {site appropriateCopyrightRep} $siteRep {break}
# site not used
}
# Find copyright repository in the appropriate language - end
# metadataRep
set metadataRep [FindMetadataRep $citedRepository]
set title [GetFieldValue $metadataRep-0 title]
set author [FormatAuthorList [GetAuthor $metadataRep-0] {;} 0 0 {&} 3]
# lappend copyrightRepositoryArray($copyrightRep) "$citedRepository - \"$title\" by $author"
lappend copyrightRepositoryArray($appropriateCopyrightRep) "$citedRepository - \"$title\" by $author"
}
}
if [info exists copyrightRepositoryArray] {
return [array get copyrightRepositoryArray]
}
# 2.
# find local copyright repository
if {![TestContentType $repName {External Contribution}]} {
# look for the local copyright
foreach index [array names repositoryProperties *,type] {
# rep
regsub {,type} $index {} rep
if [TestContentType $rep {Local Copyright}] {
if [GetDocumentState $rep] {
# the local copyright repository is from the local collection
set list [array names referenceTable $rep,*]
if {[llength $list] == 0} {
# rep is not the child of any repository (i.e., it has no parents)
# found (in the first language)
# metadataRep
set metadataRep [FindMetadataRep $rep]
set title [GetFieldValue $metadataRep-0 title]
set author [FormatAuthorList [GetAuthor $metadataRep-0] {;} 0 0 {&} 3]
set copyrightRepositoryArray($rep) "$repName - \"$title\" by $author"
return [array get copyrightRepositoryArray]
}
}
}
}
}
# 3.
# return the repository containing the copyright warning
set metadataRep [FindMetadataRep $repName]
set title [GetFieldValue $metadataRep-0 title]
set author [FormatAuthorList [GetAuthor $metadataRep-0] {;} 0 0 {&} 3]
set copyrightRepositoryArray($copyrightWarningRepository) "$repName - \"$title\" by $author"
return [array get copyrightRepositoryArray]
}
# FindCopyrightRepositories - end
# ----------------------------------------------------------------------
# GetLastUpdate
# Return the last update value (time stamp)
proc GetLastUpdate {rep-i {level {#0}}} {
upvar $level metadataArray metadataArray
return $metadataArray(${rep-i},lastupdate)
}
# GetLastUpdate - end
# ----------------------------------------------------------------------
# GetMetadataLastUpdate
# Return the last update value (time stamp)
proc GetMetadataLastUpdate {rep-i {level {#0}}} {
upvar $level metadataArray metadataArray
return $metadataArray(${rep-i},metadatalastupdate)
}
# GetMetadataLastUpdate - end
# ----------------------------------------------------------------------
# UpdateBase
# It is assumed that the field value was extracted from the service directory
# Example:
# UpdateBase $rep hostcollection $hostCollection
proc UpdateBase {rep fieldName fieldValue} {
# runs with post
global repositoryProperties
global saveMetadata
global homePath
# UPDATE REPOSITORY PROPERTIES
set repositoryProperties($rep,$fieldName) $fieldValue
# UPDATE METADATA
# metadataRep
set metadataRep [FindMetadataRep $rep]
if ![file isdirectory $homePath/col/$metadataRep] {
set metadataRep {}
}
if {[string compare {} $metadataRep] != 0} {
# remove and add
set metadataList {}
set metadata2List {}
UpdateMetadataField $metadataRep $fieldName \
$fieldValue metadataList metadata2List
RemoveMetadata $metadata2List
AddMetadata $metadataList
set saveMetadata 1
# SAVE
SaveMetadata
# SAVE - end
}
}
# UpdateBase - end
# ----------------------------------------------------------------------
# UpdateField
# example:
# UpdateField $rep $metadataRep contenttype metadataList metadata2List
# repositoryProperties array -> metadata
# used in PerformCheck, Dialog and others
proc UpdateField {rep metadataRep fieldName metadataListName metadata2ListName} {
# runs with start
# global repositoryProperties ;# post
global fieldNameArray
upvar $metadataListName metadataList
upvar $metadata2ListName metadata2List
set indexName [lindex $fieldNameArray($fieldName) 2]
if [Info exists repositoryProperties($rep,$indexName)] {
set value [Get repositoryProperties($rep,$indexName)]
if {$fieldName == "language"} {
regexp {\[(.*)\]} $value m value ;# English {[en]} -> en
}
# puts $value
if {$fieldName == "targetfile"} {
set value [join $value] ;# {RBMET_SAULO[1].pdf} -> RBMET_SAULO[1].pdf - braces appear while executing: lappend replyList $reply, within GetReply
}
# puts $value
UpdateMetadataField $metadataRep $fieldName $value metadataList metadata2List 1
} else {
DeleteMetadataField $metadataRep $fieldName metadata2List 1
}
}
# UpdateField - end
# ----------------------------------------------------------------------
# GetValue
# Example:
# GetValue repositoryProperties($rep,type)
proc GetValue {varName} {
global repositoryProperties ;# used remotely by start
global referenceTable ;# used remotely by start
global metadataArray ;# used remotely by start (see CreateIdentificationKey via Get)
global repArray ;# used remotely by start
global saveMetadata ;# used remotely by start
global startApplicationInUse ;# used remotely by start
global environmentArray ;# used by get.tcl
# return [subst $$varName]
# puts $varName
# puts [set $varName]
return [set $varName]
}
# GetValue - end
# ----------------------------------------------------------------------
# ReturnTheMostRecentVersions
# returns the five most recent versions
# example:
# set history [ReturnTheMostRecentVersions $rep]
proc ReturnTheMostRecentVersions {rep} {
# runs with post
global repositoryProperties
set history $repositoryProperties($rep,history)
set end [expr [llength $history] -1]
set begin [expr $end - 4]
return [lrange $history $begin $end]
}
# ReturnTheMostRecentVersions - end
# ----------------------------------------------------------------------
# UpdateGlobalVariable
# varName is the name of a list of repositories
# Example:
# Eval UpdateGlobalVariable indexRepList Index $rep
proc UpdateGlobalVariable {varName contentType rep} {
# runs with post
upvar #0 $varName var
# Drop the rep if it exists
if {[set i [lsearch -exact $var $rep]] != -1} {
set var [lreplace $var $i $i]
}
# Drop the rep if it exists - end
# Add the rep
if [TestContentType $rep $contentType] {
lappend var $rep
}
# Add the rep - end
}
# UpdateGlobalVariable - end
# ----------------------------------------------------------------------
# UpdateMultipleGlobalVariables
# used by PerformCheck and Dialog
proc UpdateMultipleGlobalVariables {rep} {
# runs with post
## Update indexRepList
## indexRepList is used for making access statistics
# Migration 15/9/07
if 1 {
UpdateGlobalVariable indexRepList Index $rep
}
# Migration 15/9/07 - end
## Update indexRepList - end
# Update bannerSequenceRepList
UpdateGlobalVariable bannerSequenceRepList {Banner Sequence} $rep
# Update bannerSequenceRepList - end
# Update officialIconRepList
UpdateGlobalVariable officialIconRepList {Access Icon} $rep
# Update officialIconRepList - end
# Update bannerPathArray
if [TestContentType $rep {Banner Sequence}] {
LoadBannerPathArray
}
# Update bannerPathArray - end
}
# UpdateMultipleGlobalVariables - end
# ----------------------------------------------------------------------
# ReturnNumberOfMetadataRep
# example:
# set numberOfmetadataRep [Eval ReturnNumberOfMetadataRep]
proc ReturnNumberOfMetadataRep {} {
# runs with post
global metadataArray
return [llength [array names metadataArray *,repository]]
}
# ReturnNumberOfMetadataRep - end
# ----------------------------------------------------------------------
# LoadTextLog
proc LoadTextLog {} {
# runs with start and post
global textLog
global homePath
global URLibServiceRepository
if [file exists $homePath/col/$URLibServiceRepository/auxdoc/textLog] {
Load $homePath/col/$URLibServiceRepository/auxdoc/textLog textLog
set length [llength $textLog]
set j [expr $length - 200] ;# 200 == maximum number of log lines
set textLog [lreplace $textLog 0 $j]
} else {
set textLog {}
}
}
# LoadTextLog - end
# ----------------------------------------------------------------------
# StoreTextLog
proc StoreTextLog {} {
# runs with start and post
global textLog
global homePath
global URLibServiceRepository
if [info exists textLog] {
Store textLog $homePath/col/$URLibServiceRepository/auxdoc/textLog
}
}
# StoreTextLog - end
# ----------------------------------------------------------------------
# LoadEnvironmentArray
# used in SPOK only
proc LoadEnvironmentArray {} {
# runs with post
global environmentArray
# source ../auxdoc/.environmentArray.tcl
SourceWithBackup ../auxdoc/.environmentArray.tcl environmentArray ;# added by GJFB in 2010-08-05
}
# LoadEnvironmentArray - end
# ----------------------------------------------------------------------
# CreateLanguageTable
proc CreateLanguageTable {} {
# runs with start and post
# runs with start only at installation
global referenceTable
global repositoryProperties
global englishRepository
global homePath
global environmentArray
# global languageList
# global languageTable
# languageRepositories (list of language repositories)
set languageRepositories $englishRepository
foreach index [array names referenceTable *,$englishRepository] {
regsub {,.*} $index {} rep
if [info exists repositoryProperties($rep,targetfile)] {
set targetFile $repositoryProperties($rep,targetfile)
if [regexp {Language.tcl} $targetFile] {
lappend languageRepositories $rep
}
}
}
set languageList {}
foreach languageRepository $languageRepositories {
set pathFile [glob -nocomplain $homePath/col/$languageRepository/doc/*Language.tcl]
regexp {.*/(.*)Language.tcl} $pathFile m language
set language2 $language
if [string equal {Portuguese} $language] {set language2 {Português}}
lappend languageList $language2
set languageTable($language2) $languageRepository
}
if {[lsearch -exact $languageList $environmentArray(spLanguageEntry)] == -1} {
set environmentArray(spLanguageEntry) English
}
# puts $languageList
return [array get languageTable]
}
# CreateLanguageTable - end
# ----------------------------------------------------------------------
# CreateMirrorLanguageTable
proc CreateMirrorLanguageTable {} {
global englishMirrorRepository
global portugueseBrasilMirrorRepository
set languageTable(English) $englishMirrorRepository
# set languageTable(Português) $portugueseBrasilMirrorRepository
set languageTable(Portuguese) $portugueseBrasilMirrorRepository
return [array get languageTable]
}
# CreateMirrorLanguageTable - end
# ----------------------------------------------------------------------
# CheckModifiedTime
# returns one of the values: Modified Unchanged Unchecked
# Unchanged means that
# the lastupdate in the file system == lastupdate in the metadata
#
# seconds is the mTime of the repository ($rep) being checked
# seconds is given by DirectoryMTime or RepositoryMTime; examples:
# set seconds [DirectoryMTime $homePath/col/$rep/doc 1]
# set seconds [Eval RepositoryMTime $rep $homePath 1]
#
# metadataRep and versionStamp may be given by:
# set metadataRep [FindMetadataRep $rep]
# set versionStamp [GetLastUpdate $metadataRep-0]
#
# works with gmt
# new code - adapted to migration reality (+ 1 second) and to clock ajustment for daylight saving (+- 3600 seconds or +- 7200 secconds) - by GJFB in 2010-11-23
# IR in banon-pc3 of sid.inpe.br/mtc-m12@80/2006/11.30.18.29 from m12
proc CheckModifiedTime {rep seconds {metadataRep none} {versionStamp none}} {
global homePath
# set seconds [DirectoryMTime $homePath/col/$rep/doc 1]
if {$seconds == ""} {
# repository content too big
return Unchecked
}
if {$metadataRep == "none"} {set metadataRep [FindMetadataRep $rep]}
if {$metadataRep == ""} {return Unchecked}
# lastChange1 (in the file system)
set lastChange1 $seconds
# lastChange2 (registered in the metadata)
if {$versionStamp == "none"} {set versionStamp [GetLastUpdate $metadataRep-0]}
if {[info tclversion] > 8.4} {
set lastChange2 [clock scan [lindex $versionStamp 0] -format %Y:%m.%d.%H.%M.%S -gmt 1]
} else {
set monthTable(01) Jan
set monthTable(02) Feb
set monthTable(03) Mar
set monthTable(04) Apr
set monthTable(05) May
set monthTable(06) Jun
set monthTable(07) Jul
set monthTable(08) Aug
set monthTable(09) Sep
set monthTable(10) Oct
set monthTable(11) Nov
set monthTable(12) Dec
regexp {(....):(..)\.(..)\.(..)\.(..)\.(..)} [lindex $versionStamp 0] match Y m d H M S
set lastChange2 [clock scan "$monthTable($m) $d $H:$M:$S $Y" -gmt 1]
}
set lastChange2List $lastChange2
lappend lastChange2List [expr $lastChange2 + 1]
lappend lastChange2List [expr $lastChange2 + 3600]
lappend lastChange2List [expr $lastChange2 + 3601]
lappend lastChange2List [expr $lastChange2 + 7200]
lappend lastChange2List [expr $lastChange2 + 7201]
lappend lastChange2List [expr $lastChange2 - 3600]
lappend lastChange2List [expr $lastChange2 - 3599]
lappend lastChange2List [expr $lastChange2 - 7200]
lappend lastChange2List [expr $lastChange2 - 7199]
# set xxx [list lastChange2 = $lastChange2 lastChange1 = $lastChange1]
# Store xxx C:/tmp/bbb.txt auto 0 a
# set xxx [list lastChange2List = $lastChange2List lastChange1 = $lastChange1]
# Store xxx C:/tmp/bbb.txt auto 0 a
if {[lsearch $lastChange2List $lastChange1] == -1} {
# modified version
return Modified
} else {
# unchanged version
return Unchanged
}
}
# not used - old code
proc CheckModifiedTime2 {rep seconds {metadataRep none} {versionStamp none}} {
global homePath
# set seconds [DirectoryMTime $homePath/col/$rep/doc 1]
if {$seconds == ""} {
# repository content too big
return Unchecked
}
if {$metadataRep == "none"} {set metadataRep [FindMetadataRep $rep]}
if {$metadataRep == ""} {return Unchecked}
# lastChange1 (in the file system)
set lastChange1 [clock format $seconds -format %Y:%m.%d.%H.%M.%S -gmt 1]
# lastChange2 (registered in the metadata)
if {$versionStamp == "none"} {set versionStamp [GetLastUpdate $metadataRep-0]}
set lastChange2 [lindex $versionStamp 0]
# set xxx [list lastChange2 = $lastChange2 lastChange1 = $lastChange1]
# Store xxx C:/tmp/bbb.txt auto 0 a
if {$lastChange2 != "$lastChange1"} {
# modified version
return Modified
} else {
# unchanged version
return Unchanged
}
}
# CheckModifiedTime - end
# ----------------------------------------------------------------------
# ComputeVersionState
# computes the version state of the currentRep
# if completeDiagnosis is 0
# returns one of the state values:
# Registered Original
# Modified Original
# Copy of an Original
# Modified Copy of an Original
# Unchecked
# Registered Original means that the host collection of currentRep is
# the current local collection and the repository content has not be modified
# if completeDiagnosis is 1 (used by Cover)
# returns one of the state values:
# Registered Original
# Modified Original
# Copy of the Registered Original
## Copy of a Previously Registered Original
# Copy of an Original
# Modified Copy of an Original
# Unchecked
#
# if state is Registered Original
# officialSite contains the serverAddress of the site containing the original
# otherwise officialSite is empty
#
# used in:
# GetMetadataRepositories (utilitiesMirror.tcl)
# CreateSiteEntry (utilitiesMirror.tcl)
# CreateBriefEntry (utilitiesMirror.tcl)
# GetLanguageRepositories (utilitiesMirror.tcl)
# GetURLPropertyList (utilitiesMirror.tcl)
# Cover (used completeDiagnosis == 1)
# siteListRep not used
# deletes download/doc.zip whenever the state value contains the word Modified
proc ComputeVersionState {currentRep {siteListRep {}} {completeDiagnosis 0}} {
# runs with post
global serverAddress
global homePath
global loCoInRep
global defaultAccessIconRepository
global repositoryProperties
set state {Unchecked}
set officialSite {}
set imageURL http://[ReturnHTTPHost]/rep-/$defaultAccessIconRepository
# Store imageURL C:/tmp/bbb auto 0 a
if [info exists repositoryProperties($currentRep,numberoffiles)] {
set numberOfFiles $repositoryProperties($currentRep,numberoffiles)
if {$numberOfFiles > 850} {
# two many files (RepositoryMTime is time consuming)
return [list $state $officialSite $imageURL]
} else {
set seconds [RepositoryMTime $currentRep $homePath 1]
}
} else {
# no number of files
set seconds [RepositoryMTime $currentRep $homePath 1]
}
set metadataRep [FindMetadataRep $currentRep]
if {$metadataRep == ""} {
return [list $state $officialSite $imageURL]
}
# versionStamp
set versionStamp [GetLastUpdate $metadataRep-0]
# set xxx [list command = CheckModifiedTime $currentRep $seconds $metadataRep $versionStamp]
# puts $xxx
# Store xxx C:/tmp/bbb.txt auto 0 a
set check [CheckModifiedTime $currentRep $seconds $metadataRep $versionStamp]
# set xxx [list check = $check]
# Store xxx C:/tmp/aaa auto 0 a
if [regexp Unchecked $check] {
return [list $state $officialSite $imageURL]
}
# lastHostCollection
set lastHostCollection [lindex [LoadHostCollection $currentRep] end]
if 0 {
# officialIconRep
set officialIconRep [GetOfficialIconRep]
if {$officialIconRep == ""} {
# the official icon has not been created for this site
set officialIconRep $defaultAccessIconRepository
}
}
# set state {}
if [regexp Modified $check] {
# Modified
if {$lastHostCollection == "$loCoInRep"} {
# the host collection of currentRep is the current local collection
# >>> Modified Original
set state {Modified Original}
} else {
# the host collection of currentRep is not the current local collection
# >>> Modified Copy of an Original
set state {Modified Copy of an Original}
}
} else {
# Unchanged
## Look for official version
if {$lastHostCollection == "$loCoInRep"} {
# the host collection of currentRep is the current local collection
# set state Official
# >>> Registered Original
set state {Registered Original}
set officialSite $serverAddress
if {![TestContentType $currentRep {External Contribution}] \
&& ![TestContentType $currentRep {Copyright}]} {
set officialIconRep [GetOfficialIconRep]
if {$officialIconRep != ""} {
# the official icon has been created for this site
set imageURL http://[ReturnHTTPHost]/rep-/$officialIconRep
}
}
} else {
# the host collection of currentRep is not the current local collection
if $completeDiagnosis {
set officialSite [FindSiteContainingTheOriginal2 $currentRep] ;# with ip
if [string equal {} $officialSite] {
# official site not found
# >>> Copy of an Original
set state {Copy of an Original}
} else {
# official site found
set versionState [Execute $officialSite [list ComputeVersionState $currentRep]]
if [string equal {} $versionState] {
# official site is not returning - (for example when using banon-pc3 with INPE wireless and trying to open an administrator page using Get) - GJFB in 2010-12-06
set state {Copy of an Original}
} else {
foreach {state2 officialSite imageURL} $versionState {break}
if [string equal {Registered Original} $state2] {
# set versionStamp2 [Execute $officialSite [list GetLastUpdate $metadataRep-0]]
if [catch {Execute $officialSite [list GetLastUpdate $metadataRep-0]} versionStamp2] {
# example of error message:
# Execute: communication with server banon-pc3 800 [banon-pc3 800] doesn't start
set state {Copy of an Original}
} else {
if {$versionStamp == "$versionStamp2"} {
# >>> Copy of the Registered Original
set state {Copy of the Registered Original}
} else {
## >>> Copy of a Previously Registered Original
# set state {Copy of a Previously Registered Original}
# >>> Copy of an Original
set state {Copy of an Original}
}
}
} else {
## >>> Copy of a Previously Registered Original
# set state {Copy of a Previously Registered Original}
# >>> Copy of an Original
set state {Copy of an Original}
}
}
}
} else {
# >>> Copy of an Original
set state {Copy of an Original}
}
}
## Look for official version - end
}
array set stateTable {
{Registered Original} {Official}
{Modified Original} {Modified}
{Copy of the Registered Original} {Official}
{Copy of an Original} {Copied}
{Modified Copy of an Original} {Modified}
{Unchecked} {Unchecked}
}
if [string equal {Modified} $stateTable($state)] {
file delete $homePath/col/$currentRep/download/doc.zip ;# added by GJFB in 2012-12-25 - needed because the download/doc.zip is not automatically updated when an UpdateLastUpdate is done (resulting in out-of-date doc.zip)
}
return [list $state $officialSite $imageURL]
}
# ComputeVersionState - end
# ----------------------------------------------------------------------
# GetPermission
# directory value is doc or download
proc GetPermission {directory} {
# runs with post
global environmentArray
regsub {d} $directory {D} directory
return [lindex [split $environmentArray(sp${directory}AccessPermission) \n] end]
}
# GetPermission - end
# ----------------------------------------------------------------------
# Migrate1
# Migrates from Version 1 to Version 2
# Creates a metadata repository if it doesn't exist
proc Migrate1 {rep} {
# runs with post
global homePath
global bib2referRepository
global saveMetadata
global loCoInRep
global tcl_platform
if {$tcl_platform(platform) == "unix" && \
[file isdirectory $homePath/col/$rep/bib] && \
![file isdirectory $homePath/col/$rep/service]} {
# rep is of Version 1
set path1 [eval file join [lrange [file split $rep] 0 2]]
set path2 [lindex [file split $rep] end]
set firstCharacter [string index [exec ls -l $homePath/col/$path1 | grep $path2] 0]
if {$firstCharacter == "d"} {
set metadataRep [FindMetadataRep $rep]
if ![file isdirectory $homePath/col/$metadataRep] {
# UpdateVariables $metadataRep
set metadataRep {}
}
set bibPath [glob $homePath/col/$rep/bib/*/a.bib]
regsub {/a.bib$} $bibPath {} bibPath
if {$metadataRep == {}} {
if ![file isdirectory $homePath/col/$rep/service] {
file mkdir $homePath/col/$rep/auxdoc
file mkdir $homePath/col/$rep/source
file mkdir $homePath/col/$rep/service
# size and numberOfFiles
# set size [ComputeSize $rep]
foreach {size numberOfFiles} [ComputeInfo $rep] {break}
Store size $homePath/col/$rep/service/size
Store numberOfFiles $homePath/col/$rep/service/numberOfFiles
# hostCollection
StoreHostCollection $rep $loCoInRep
# history
# CREATE A NEW VERSION STAMP
set seconds [DirectoryMTime $homePath/col/$rep/doc]
set versionStamp [CreateVersionStamp $seconds]
UpdateHistory $rep $versionStamp
# reference
Load $homePath/col/$rep/.reserved/ref reference
set referenceList1 [split $reference \n]
if {$referenceList1 != {}} {
set referenceList2 {}
foreach ref $referenceList1 {
lappend referenceList2 ../../../../../../col/$ref
}
set reference [join $referenceList2 \n]
Store reference $homePath/col/$rep/service/reference
}
}
# no metadataRep exists
# create a metadata repository
Load $bibPath/a.bib bibTeXEntry
set referEntry [${bib2referRepository}::Bib2Refer $bibTeXEntry]
regsub {(%0[^%]*)} $referEntry "\\1%4 $rep\n" referEntry
set metadataList [LoadMetadata $referEntry] ;# startApacheServer
AddMetadata $metadataList
set saveMetadata 1
}
}
return 0
} else {
return 1
}
}
# Migrate1 - end
# ----------------------------------------------------------------------
# Migrate2
# Migrates from Version 1 to Version 2
# Updates the metadata in both versions
# was used in PerformCheck
proc Migrate2 {rep} {
# runs with post
global homePath
global bib2referRepository
if [file isdirectory $homePath/col/$rep/bib] {
# rep is of Version 1
set metadataRep [FindMetadataRep $rep]
if ![file isdirectory $homePath/col/$metadataRep] {
# UpdateVariables $metadataRep
set metadataRep {}
}
set bibPath [glob $homePath/col/$rep/bib/*/a.bib]
regsub {/a.bib$} $bibPath {} bibPath
if {$metadataRep != {}} {
# a metadataRep exists
set seconds1 [DirectoryMTime $bibPath]
set referPath $homePath/col/$metadataRep/doc
set seconds2 [DirectoryMTime $referPath]
if [expr abs($seconds1 - $seconds2) > 10] {
# the versions are different
if {$seconds1 < $seconds2} {
# update Version 1
Load $referPath/@metadata.refer referEntry
set metadataList [ConvertRefer2MetadataList $referEntry $metadataRep 0]
set rep-i $metadataRep-0
set bibTeXEntry { Bibligraphic index {}}
foreach item [CreateBibTeXEntry $metadataList ${rep-i}] {
if [regexp {metadatarepository =| repository =} $item] {continue}
lappend bibTeXEntry $item
}
lappend bibTeXEntry {}
lappend bibTeXEntry {}
set bibTeXEntry [join $bibTeXEntry \n]
Store bibTeXEntry $bibPath/a.bib
} else {
# update Version 2
Load $bibPath/a.bib bibTeXEntry
set referEntry [${bib2referRepository}::Bib2Refer $bibTeXEntry]
regsub {(%0[^%]*)} $referEntry "\\1%4 $rep\n" referEntry
regsub {(%0[^%]*)} $referEntry "\\1%2 $metadataRep\n" referEntry
}
# store Version 2 anyway
Store referEntry $referPath/@metadata.refer
}
}
}
}
# Migrate2 - end
# ----------------------------------------------------------------------
# BackupRegisteredVersion
# used in MakeDownloadFile
proc BackupRegisteredVersion {rep} {
# runs with post
global col
global repositoryProperties
if [file exists $col/$rep/download/doc.zip] {
if [file exists $col/$rep/download/sample] {
if [file exists $col/$rep/download/time] {
# Backup the old registered version
set history $repositoryProperties($rep,history)
set historyLength [llength $history]
set versionStamp [lindex $history [expr $historyLength - 2]]
regsub -all {[:/]} $versionStamp {=} versionStamp
file mkdir $col/$rep/backup/$versionStamp
file copy $col/$rep/download/doc.zip $col/$rep/backup/$versionStamp/doc.zip
file copy $col/$rep/download/sample $col/$rep/backup/$versionStamp/sample
file copy $col/$rep/download/history $col/$rep/backup/$versionStamp/history
file copy $col/$rep/download/time $col/$rep/backup/$versionStamp/time
# Backup the old registered version - end
}
file delete $col/$rep/download/sample
file delete $col/$rep/download/history
file delete $col/$rep/download/time
}
# file delete $col/$rep/download/doc.zip ;# commented in 2010-07-04
}
}
# BackupRegisteredVersion - end
# ----------------------------------------------------------------------
# MakeDownloadFile
# packEverything value is 0, 1 or 2
# 0 means to pack just doc, agreement, images and part of service
# 1 means to pack everything (i.e., besides doc, agreement, images and part of service, source, backup and not_sent directories)
# 2 means to pack everything except doc, agreement and images
# force value is 0 or 1
# 1 means to execute TestUpdateLastUpdate even for $rep
# backup value is 0 or 1
# 1 means that the current version must be registered and then back it up
# userName used by TestUpdateLastUpdate (called by ComputeRepositoryList) to create the version stamp
# dontMakeIfItExists value is 0 (default) or 1
# 1 means to don't make the download file if it already exists
# used only in:
# iconet.com.br/banon/2002/02.04.12.37
# iconet.com.br/banon/2002/02.02.20.42
# iconet.com.br/banon/2002/02.02.09.41
proc MakeDownloadFile {
rep {packEverything 0} {force 0} {backup 0} {userName {}} {dontMakeIfItExists 0}
} {
# runs with post
global homePath
global pwd
# global referenceTable ;# commented by GJFB in 2015-04-18
global URLibServiceRepository
global downloadingEnvironmentRepository
# global samplingRepository
# global repositoryProperties ;# commented by GJFB in 2015-04-18
global downloadForWindowsRepository
global downloadForSunOSRepository
global downloadForLinuxRepository
global zipPath
# global tcl_platform
if {$dontMakeIfItExists && [file exists $homePath/col/$rep/download/doc.zip]} {return}
# set xxx [CallTrace]
# Store xxx C:/tmp/bbb.txt auto 0 a
# puts $packEverything
set currentDownloadPermission [FindCurrentDownloadPermission $rep]
# puts --$currentDownloadPermission--
if {!$backup && [string equal $currentDownloadPermission {deny from all}]} {
file delete $homePath/col/$rep/download/doc.zip
file delete $homePath/col/$rep/download/history
file delete $homePath/col/$rep/download/sample
return
}
file delete $homePath/col/$URLibServiceRepository/doc/core ;# delete core file (if any)
file mkdir $homePath/col/$rep/download
# Compute repositoryList
# set repositoryList [ComputeRepositoryList $rep $force] ;# parent repositories + $rep + metadata repositories
set repositoryList [ComputeRepositoryList $rep $force $userName] ;# parent repositories + $rep + metadata repositories
# puts --$repositoryList--
# Compute repositoryList - end
Store repositoryList $homePath/repositoryList
# if {$tcl_platform(platform) == "unix"} #
# if [file owned $zipPath] {exec chmod 774 $zipPath} ;# must be executable
# #
set command "$zipPath"
set option "-r"
set type zip
# file delete $homePath/col/$rep/download/doc.$type
BackupRegisteredVersion $rep
if {$packEverything != 2} {
file delete $homePath/col/$rep/download/doc.zip
}
# Compute fileList1 and fileList2 (could be one list)
set fileList1 {} ;# just for doc
set fileList2 {} ;# for the rest (except service)
foreach repository $repositoryList {
# lappend fileList1 col/$repository/doc ;# commented by GJFB in 2013-02-09 - see new code below
if [file isdirectory $homePath/col/$repository/agreement] {
lappend fileList1 col/$repository/agreement
}
if [file isdirectory $homePath/col/$repository/images] {
lappend fileList1 col/$repository/images
}
# Preserve the administrator as an advanced user
LoadService $repository userName userName 1 1
if [string equal {administrator} $userName] {
# user name is administrator
set userNamePath {} ;# don't exclude (see below) - useful for administrator pages
} else {
set userNamePath col/$repository/service/userName
}
# Preserve the administrator as an advanced user - end
if 0 {
# commented by GJFB in 2018-09-08 - see below
# Preserve the administrator as a user (authenticated user) - added by GJFB in 2018-06-02
LoadService $repository authenticatedUsers authenticatedUsers 0 1
if [string equal {administrator} $authenticatedUsers] {
# user name is administrator
set authenticatedUsersPath {} ;# don't exclude (see below) - useful for the administrator page
} else {
set authenticatedUsersPath col/$repository/service/authenticatedUsers
}
# Preserve the administrator as an advanced user - end
}
cd $homePath
# if [catch {eval "exec \"$command\" $option \"$homePath/col/$rep/download/doc.$type\" col/$repository/service -x col/$repository/service/registrationPassword $userNamePath col/$repository/service/authenticatedUsers col/$repository/service/accessLog"} message] #
# ZIP (part of service)
# if [catch {eval "exec \"$command\" $option \"$homePath/col/$rep/download/doc.$type\" col/$repository/service -x col/$repository/service/hostCollection col/$repository/service/transferableFlag $userNamePath col/$repository/service/authenticatedUsers col/$repository/service/accessLog"} message] # ;# commented by GJFB in 2018-06-02
# if [catch {eval "exec \"$command\" $option \"$homePath/col/$rep/download/doc.$type\" col/$repository/service -x col/$repository/service/hostCollection col/$repository/service/transferableFlag $userNamePath $authenticatedUsersPath col/$repository/service/accessLog"} message] # ;# added by GJFB in 2018-06-02 - useful for the administrator page - commented by GJFB in 2018-09-08
if [catch {eval "exec \"$command\" $option \"$homePath/col/$rep/download/doc.$type\" col/$repository/service -x col/$repository/service/hostCollection col/$repository/service/transferableFlag $userNamePath col/$repository/service/accessLog"} message] { ;# added by GJFB in 2018-09-08 - it seems convenient not to exclude any members of the reader group
set log "\[[clock format [clock seconds] -format %Y:%m.%d.%H.%M.%S]\] MakeDownloadFile (1): $message\n"
puts $log
Store log $homePath/@errorLog auto 0 a
}
if {$packEverything != 2} {
# ZIP (part of doc) - added by GJFB in 2013-02-09 to exclude doc/tmp
if [catch {eval "exec \"$command\" $option \"$homePath/col/$rep/download/doc.$type\" col/$repository/doc -x col/$repository/doc/tmp/*"} message] {
set log "\[[clock format [clock seconds] -format %Y:%m.%d.%H.%M.%S]\] MakeDownloadFile (1): $message\n"
puts $log
Store log $homePath/@errorLog auto 0 a
}
}
cd $pwd
if $packEverything {
if ![TestContentType $rep Metadata] {
if [file isdirectory $homePath/col/$repository/source] {
lappend fileList2 col/$repository/source
}
if [file isdirectory $homePath/col/$repository/backup] {
lappend fileList2 col/$repository/backup
}
if [file isdirectory $homePath/col/$repository/not_sent] {
lappend fileList2 col/$repository/not_sent
}
if [file exists $homePath/col/$repository/download/sample] {
lappend fileList2 col/$repository/download/sample
}
if [file exists $homePath/col/$repository/download/history] {
lappend fileList2 col/$repository/download/history
}
if [file exists $homePath/col/$repository/download/time] {
lappend fileList2 col/$repository/download/time
}
}
}
}
if {$rep == "$URLibServiceRepository" || \
$rep == "$downloadForWindowsRepository" || \
$rep == "$downloadForSunOSRepository" || \
$rep == "$downloadForLinuxRepository" || \
$rep == "$downloadingEnvironmentRepository"} {
if [file exists $homePath/newVersion] {lappend fileList2 newVersion}
}
if {$rep == "$downloadForSunOSRepository" || \
$rep == "$downloadForLinuxRepository" || \
$rep == "$downloadingEnvironmentRepository"} {
lappend fileList2 start ;# start script for UNIX
}
if 0 {
# shortcut cannot be zipped
if {$rep == "$downloadForWindowsRepository"} { ;# added by GJFB in 2017-10-14
lappend fileList2 {"post URLib"} ;# atalho para c:\URLib
lappend fileList2 {"unpost URLib"} ;# atalho para c:\URLib
lappend fileList2 {"start URLib"} ;# atalho para c:\URLib
lappend fileList2 {"update URLib"} ;# atalho para c:\URLib
lappend fileList2 {"reset URLib"} ;# atalho para c:\URLib
}
}
lappend fileList2 packedRepository ;# used by IR
lappend fileList2 packedRepositoryVersion ;# used by IR
lappend fileList2 repositoryList ;# used by IR
# Compute fileList1 and fileList2 - end
# Store packedRepository and packedRepositoryVersion
# must be after ComputeRepositoryList
set packedRepository $rep
Store packedRepository $homePath/packedRepository
# set packedRepositoryVersion [lindex $repositoryProperties($rep,history) end]
set packedRepositoryVersion [GetVersionStamp $rep]
Store packedRepositoryVersion $homePath/packedRepositoryVersion
# Store packedRepository and packedRepositoryVersion - end
cd $homePath
if {$packEverything != 2} {
## ZIP (doc, agreement and images) ;# commented by GJFB in 2013-02-09
# ZIP (agreement and images)
# -x col/$repository/service/hostCollection
if ![string equal {} $fileList1] {
if [catch {eval "exec \"$command\" $option \"$homePath/col/$rep/download/doc.$type\" $fileList1"} message] {
set log "\[[clock format [clock seconds] -format %Y:%m.%d.%H.%M.%S]\] MakeDownloadFile (2): $message\n"
puts $log
Store log $homePath/@errorLog auto 0 a
}
}
}
# ZIP (source and others)
if [catch {eval "exec \"$command\" $option \"$homePath/col/$rep/download/doc.$type\" $fileList2"} message] {
## puts "exec \"$command\" $option \"$homePath/col/$rep/download/doc.$type\" [join $fileList2]"
# if [catch {eval "exec \"$command\" $option \"$homePath/col/$rep/download/doc.$type\" [join $fileList2]"} message] # ;# added by GJFB in 2017-10-14 - {"unpost URLib"} {"post URLib"} -> "unpost URLib" "post URLib"
set log "\[[clock format [clock seconds] -format %Y:%m.%d.%H.%M.%S]\] MakeDownloadFile (3): $message\n"
puts $log
Store log $homePath/@errorLog auto 0 a
}
# puts source
cd $pwd
# set xxx [list $rep done]
# Store xxx C:/tmp/aaa auto 0 a
}
# MakeDownloadFile - end
# ----------------------------------------------------------------------
# ComputeRepositoryList
# includes parent repositories + $rep + metadata repositories
# force value is 0 or 1
# 1 means to execute TestUpdateLastUpdate even for $rep
# userName used by TestUpdateLastUpdate to create the version stamp
# used in MakeDownloadFile only
proc ComputeRepositoryList {rep force {userName {}}} {
# runs with post
global saveMetadata
global col
set repositoryList [CreateCitedRepositoryList $rep] ;# all parent repositories (inclusive parents of parents)
# Exclude non original parents of an original document
# useful when testing the INPE bibliografic mirror in gjfb.home
# in m19 (where is the INPE bibliografic mirror is the original) the parent: dpi.inpe.br/banon/1999/05.03.22.11 is not the original and must be part of the download file for exportation
# added by GJFB in 2015-07-04
if [GetDocumentState $rep] {
# the document is the original
set repositoryList2 {}
foreach rep2 $repositoryList {
if [GetDocumentState $rep2] {
# the document is the original
lappend repositoryList2 $rep2 ;# just append original document
} else {
puts $rep2
}
}
set repositoryList $repositoryList2
}
# Exclude non original parents of an original document - end
lappend repositoryList $rep
if ![info exists saveMetadata] {set saveMetadata 0}
foreach repName $repositoryList {
set metadataRep [FindMetadataRep $repName]
if {$metadataRep != {}} {
set languageVersions [FindAllLanguageVersions $metadataRep]
foreach mRep $languageVersions {
lappend repositoryList $mRep
}
if {$force || ![string equal $rep $repName]} {
# set newer [TestUpdateLastUpdate $repName $metadataRep 1 $userName]
set newer [TestUpdateLastUpdate $repName $metadataRep 1 $userName 0] ;# don't update child last update - added by GJFB in 2010-08-20
set saveMetadata [expr $saveMetadata || $newer]
if {$newer && ![string equal $rep $repName]} {
# set xxx parent
# Store xxx C:/tmp/aaa auto 0 a
# UpdateDownloadFile $repName ;# may set saveMetadata to 1
UpdateDownloadFile $repName 0 0 $userName ;# may set saveMetadata to 1
}
}
}
}
return $repositoryList
}
# ComputeRepositoryList - end
# ----------------------------------------------------------------------
# CountOneClick
# URParts example: dpi.inpe.br banon 1998 08.02.08.56
proc CountOneClick {URParts clientIPAddress} {
global col
global homePath
global URLibServiceRepository
# global serverAddressWithIP
# set x 0; after 3000 {set x 1}; vwait x ;# just for comparing execution time with Get-
set rep [join $URParts /]
if [GetDocumentState $rep] {
# the original document
# Waiting for the completion of other CountOneClick
# Waiting for the completion of other clicks
WaitQueue CountOneClick $rep
# Waiting for the completion of other clicks - end
# Waiting for the completion of other CountOneClick - end
set day [clock format [clock seconds] -format %Y.%m.%d]
if [file exists $homePath/col/$rep/service/clientIPLog] {
source $homePath/col/$rep/service/clientIPLog ;# set clientIPArray
# array get clientIPArray
# =>
# 2015.05.05 {192.168.1.31} 2015.05.06 {192.168.1.31 192.168.1.32}
}
if [info exists clientIPArray($day)] {
# not the first click of the day
if {[set index [lsearch $clientIPArray($day) $clientIPAddress]] == -1} {
# ip doesn't exist
lappend clientIPArray($day) $clientIPAddress
}
} else {
# first click of the day
set index -1 ;# ip doesn't exist
set clientIPArray($day) $clientIPAddress
}
StoreArray clientIPArray $homePath/col/$rep/service/clientIPLog w list array 1
if {$index == -1} {
# the ip is new for the current day - count on click
if [file exists $homePath/col/$rep/service/accessLog] {
# not the first click
Load $homePath/col/$rep/service/accessLog fileContent
set lineList [split $fileContent \n]
set lastLine [lindex $lineList end]
if [regexp "^$day" $lastLine] {
# not the first click of the day
regexp {(.*)-(.*)} $lastLine m day numberOfClicks
incr numberOfClicks ;# + 1
set newLastLine $day-$numberOfClicks
set lineList [lreplace $lineList end end $newLastLine]
} else {
# first click of the day
set newLastLine $day-1
lappend lineList $newLastLine
}
set fileContent [join $lineList \n]
} else {
# first click
set fileContent $day-1
}
Store fileContent $homePath/col/$rep/service/accessLog
}
LeaveQueue [pid] $rep
} else {
# not the original document
if 1 {
set siteContainingTheOriginal [FindSiteContainingTheOriginal2 $rep]
# puts --$siteContainingTheOriginal--
# sometimes the serverAddressWithIP of the site containing the original may be 127.0.0.1 in a wrong way
# this already occured after a breakdown (with marte)
# the solution to this problem was included in Execute
# warning: in standalone mode there are no click counts
if ![string equal {} $siteContainingTheOriginal] {
# if {![regexp {127.0.0.1} $siteContainingTheOriginal] && [string equal {} $siteContainingTheOriginal]} #
# if {(![regexp {127.0.0.1} $siteContainingTheOriginal] || [regexp {127.0.0.1} $serverAddressWithIP]) && \
# ![string equal {} $siteContainingTheOriginal]} #
if [catch {Execute $siteContainingTheOriginal [list PostponeOneClickCount $URParts $clientIPAddress]} message] {
set log "\[[clock format [clock seconds] -format %Y:%m.%d.%H.%M.%S]\] CountOneClick:\nthe command: [list PostponeOneClickCount $URParts] cannot be executed for the following reason:\n$message\n"
puts $log
Store log $homePath/@errorLog auto 0 a
}
}
}
}
}
# CountOneClick - end
# ----------------------------------------------------------------------
# PostponeOneClickCount
# URParts example: dpi.inpe.br banon 1998 08.02.08.56
proc PostponeOneClickCount {URParts clientIPAddress} {
return [list $URParts $clientIPAddress] ;# {{urlib.net www 2014 03.25.23.20} 192.168.1.31}
}
# PostponeOneClickCount - end
# ----------------------------------------------------------------------
# ReturnSiteContainingTheOriginal
# without ip (ip == 0) is used in Statistics
proc ReturnSiteContainingTheOriginal {rep {ip 1}} {
global serverAddressWithIP
global serverAddress
# puts $serverAddressWithIP
if [GetDocumentState $rep] {
# rep contains the original
if $ip {
# return $serverAddressWithIP
return [list $serverAddressWithIP]
} else {
# return $serverAddress ;# use this line for texting clearing channel (click in statistics) - see also FindSiteContainingTheOriginal
return [list $serverAddress]
}
}
}
# ReturnSiteContainingTheOriginal - end
# ----------------------------------------------------------------------
# StartApacheServerAfterSubmission
# used in ServeLocalCollection
proc StartApacheServerAfterSubmission {} {
}
# StartApacheServerAfterSubmission - end
# ----------------------------------------------------------------------
# ConvertPS2PDF
# used by Submit
proc ConvertPS2PDF {ps2pdfConverterPath repName fileName} {
global homePath
if [catch {exec $ps2pdfConverterPath $homePath/col/$repName/doc/$fileName &} message] {
return $message
}
}
# ConvertPS2PDF - end
# ----------------------------------------------------------------------
# StartPS2PDFConversionAfterSubmission
# used in ServeLocalCollection
# not used
proc StartPS2PDFConversionAfterSubmission {ps2pdfConverterPath repName} {
return [list $ps2pdfConverterPath $repName]
}
# StartPS2PDFConversionAfterSubmission - end
# ----------------------------------------------------------------------
# SaveToDisk
proc SaveToDisk {} {
# runs with post
# global referenceTable
# global repositoryProperties
# StoreArray referenceTable ../auxdoc/.referenceTable.tcl w list
# StoreArray repositoryProperties ../auxdoc/.repositoryProperties.tcl w list
SaveRepositoryProperties
SaveReferenceTable
SaveMetadata
}
# SaveToDisk - end
# ----------------------------------------------------------------------
# PostponeSaveToDisk
proc PostponeSaveToDisk {} {
}
# PostponeSaveToDisk - end
# ----------------------------------------------------------------------
# ReturnTargetFileContent
# used by Copyright (copyright.tcl) only
proc ReturnTargetFileContent {rep} {
global homePath
set targetFile [GetTargetFile $rep]
Load $homePath/col/$rep/doc/$targetFile fileContent
return [split $fileContent \n]
}
# ReturnTargetFileContent - end
# ----------------------------------------------------------------------
# RegisterSampledDocument
proc RegisterSampledDocument {rep lastUpdate sampleC} {
global homePath
global sampledDocumentDBRepository
# docPath
set docPath $homePath/col/$sampledDocumentDBRepository/doc
set URParts [file split $rep]
set year [lindex $URParts 2]
set rest [lreplace $URParts 2 2]
regsub -all { } $rest {=} rest
regsub -all {[:/]} $lastUpdate {=} versionStamp
# directoryPath
set directoryPath $docPath/$year/$rest/$versionStamp
if [file isdirectory $directoryPath] {return} ;# security issue
file mkdir $directoryPath
set sample [binary format c* $sampleC]
Store sample $directoryPath/sample binary 1
# CREATE A NEW VERSION STAMP
set time [CreateVersionStamp [clock seconds]]
Store time $directoryPath/time
return $time
}
# RegisterSampledDocument - end
# ----------------------------------------------------------------------
# ReturnHostCollection
# returns the host collection identifier (i.e., the name of the local collection index repository)
# and the registrationPassword of the repository ($rep)
# if the calling client is the URLib server, otherwise returns empty
proc ReturnHostCollection {rep} {
# runs with post
upvar addr addr
set urlibServerAddressWithIP [GetURLibServerAddress] ;# ip and port of urlib.net
# puts $urlibServerAddressWithIP ;# 150.163.34.64 800
# foreach {ip urlibPort} [ReturnCommunicationAddress $urlibServerAddressWithIP] {break} ;# commented by GJFB in 2017-12-20
foreach {ip} $urlibServerAddressWithIP {break} ;# added by GJFB in 2017-12-20 to avoid useless call to ReturnCommunicationAddress
# puts [list $addr $ip]
if [string equal $addr $ip] {
# URLib server is calling
set hostCollection [LoadHostCollection $rep]
LoadService $rep registrationPassword registrationPassword 1 1
return [list $hostCollection $registrationPassword]
}
}
# ReturnHostCollection - end
# ----------------------------------------------------------------------
# RegisterRepositoryName
# URLib server side
# returns 0 if registered
# copyright transfer protocol (from A to B) - here A and B are the identifiers of the respective collections
# 1. a repository is created in collection A (hostCollection value is A)
## 2. the repository is registered with copyright to A (A as hostCollection value + a registration password) (see RegisterRepositoryName - RegisterRepositoryName is called by RegisterRepository)
# 2. the repository is registered with copyright to A (hostCollection value is A) (see RegisterRepositoryName - RegisterRepositoryName is called by RegisterRepository)
# 3. collection B allows copyright transfer from A (see @sitesAllowedToTransferCopyright.tcl file in collection B)
# 4. A appends B to the hostCollection value (hostCollection value becomes the list {A B} - done in UpdateHostCollectionFieldValue which is called by TransferCopyright) and changes the transferable flag to zero (it must be one before the transfer beginning) (see TransferCopyright)
# 5. A restricts the doc.zip download access to B (see TransferCopyright)
## 6. A updates doc.zip (including registration password) (see TransferCopyright)
# 6. A updates doc.zip (including host collection) (see TransferCopyright)
# 7. A asks B to capture doc.zip (see TransferCopyright)
# 8. B captures the doc.zip (see CaptureRepository)
# 9. B informs A that the transfer is complete (see CaptureRepository)
# 10. A deletes the hostCollection file (see CaptureRepository)
# if A doesn't return to B the message transferable, transferNotCompleted is created in B for further tentative from the URLibService interface
# 10b. A registers the repository as B (should be done in the future - the transferable flag in B should remain zero until the new repository registration))
# 11. B turns its transferable flag to one - from now on, B could transfer its copyrights to any other local collection
# >>> RegisterRepositoryName need to be updated to include registration of copies (now a copy has an empty host collection value)
# 12. B asks to register the repository as B, displaying the hostCollection value {A B}, the old password and a new password (see CaptureRepository - CaptureRepository calls InstallRepository - InstallRepository calls RegisterRepository)
### 12. B asks to A registering the repository as B, (see CaptureRepository - CaptureRepository calls InstallRepository - InstallRepository calls RegisterRepository)
## 13. the server asks confirmation to A (A must return the new hostCollection value {A B {}} and the old registration password as registered by the server)
# 13. A ask the server to register the repository with copyright to B (hostCollection value becomes {A B})
## 14. the server checks the old registration password displayed by B, it must agree with the old registration password registered by the server (see RegisterRepositoryName)
## 15. the repository is registered (again) but now with the list {A B} as value of hostCollection and with the new registration password displayed by B (see RegisterRepositoryName)
# not in used
# >>> RegisterRepositoryName need to be updated to include registration of copies (now a copy has an empty host collection value)
proc RegisterRepositoryName {rep hostCollection registrationPassword oldRegistrationPasswordInNewHostCollection {url {}}} {
global homePath
global repositoryNameDBRepository
global loBiMiRep
# set xxx [list $rep $hostCollection $registrationPassword]
# Store xxx C:/tmp/bbb auto 0 a
# docPath
set docPath $homePath/col/$repositoryNameDBRepository/doc
set URParts [file split $rep]
set year [lindex $URParts 2]
set rest [lreplace $URParts 2 2]
regsub -all { } $rest {=} rest
# directoryPath
set directoryPath $docPath/$year/$rest ;# doc/2008/dpi.inpe.br=hermes2@80=08.22.00.00
if [file isdirectory $directoryPath] {
# repository name already registered
# check for the new host collection
Load $directoryPath/hostCollection data binary
set data [UnShift $data]
if {[lindex $data 0] != "$rep"} {return 1} ;# corrupted hostCollection
set oldHostCollection [lindex $data end]
# set xxx $oldHostCollection
# Store xxx C:/tmp/bbb auto 0 a
Load $homePath/col/$loBiMiRep/doc/@siteList.txt fileContent
set found 0
foreach line [split $fileContent \n] {
if [string equal $oldHostCollection [lindex $line 1]] {
set oldHostCollectionSite [lindex $line 0]
set found 1 ;# old host collection (A) is still registered
break
}
}
# set xxx $found
# Store xxx C:/tmp/bbb auto 0 a
if $found {
set command [list list ReturnHostCollection $rep]
# set xxx [list $oldHostCollectionSite $command]
# Store xxx C:/tmp/bbb auto 0 a
# MULTIPLE SUBMIT
set collectionPassword [MultipleExecute [list $oldHostCollectionSite] $command]
# set xxx --$collectionPassword--
# Store xxx C:/tmp/bbb auto 0 a
foreach {newHostCollection oldRegistrationPasswordInOldHostCollection} $collectionPassword {break}
if ![string equal $newHostCollection $hostCollection] {return 1} ;# inconsistency
# the site (== $hostCollection) requiring the repository registration is the one which has
# received the copyrights from the site which has transferred them
# in other words, the previoulsy registered host collection A ($oldHostCollection) is
# confirming that B ($hostCollection) is the new host collection
Load $directoryPath/password data binary
set data [UnShift $data]
if {[lindex $data 0] != "$rep"} {return 1} ;# corrupted password
set oldRegistrationPasswordInServer [lindex $data end]
if ![string equal $oldRegistrationPasswordInServer $oldRegistrationPasswordInOldHostCollection] {return 1} ;# different passwords
# the calling site A (the old host collection) knows the old registation password
if ![string equal $oldRegistrationPasswordInServer $oldRegistrationPasswordInNewHostCollection] {return 1} ;# different passwords
# the calling site B (the new host collection) knows the old registation password
} else {return 1} ;# site A not found
} else {
# new repository name to be registered
file mkdir $directoryPath
}
set data [Shift $rep $hostCollection]
Store data $directoryPath/hostCollection binary 1 ;# nonewline
set data [Shift $rep $registrationPassword]
Store data $directoryPath/password binary
return 0 ;# registration done
}
# RegisterRepositoryName - end
# ----------------------------------------------------------------------
# RegisterRepository
# client side
# used by PerformCheck, CreateRepMetadataRep, UpdateRepMetadataRep and InstallRepository (only)
# forceRegistration value is 0 or 1
# 1 means to force registration
# (set to 1 in CaptureRepository (see InstallRepository arguments)
# when called from InstallRepository, the request comes from B
# not in used
# >>> RegisterRepositoryName need to be updated to include registration of copies (now a copy has an empty host collection value)
proc RegisterRepository {rep {forceRegistration 0}} {
# runs with post
global homePath
global loCoInRep
global urlibServerAddress ;# urlib.net and port
if {[GetDocumentState $rep] && \
![TestContentType $rep Metadata] && \
[file exists $homePath/col/$rep/service/size]} {
# contains a non empty original document
if {$forceRegistration || [CheckRegistration $rep]} {
# not registered
# oldRegistrationPassword
if $forceRegistration {
if [file exists $homePath/col/$rep/service/registrationPassword] {
if [LoadService $rep registrationPassword oldRegistrationPassword 1 1] {return} ;# corrupted password
StoreService oldRegistrationPassword $rep oldRegistrationPassword 1 1 ;# because registration may fail
file delete $homePath/col/$rep/service/registrationPassword ;# to force the creation of a new password (see below)
} else {
set oldRegistrationPassword {}
}
} else {
if [file exists $homePath/col/$rep/service/oldRegistrationPassword] {
if [LoadService $rep oldRegistrationPassword oldRegistrationPassword 1 1] {return} ;# corrupted password
} else {
set oldRegistrationPassword {}
}
}
if ![file exists $homePath/col/$rep/service/registrationPassword] {
# registrationPassword file doesn't exist
# CREATE registrationPassword
regsub {0\.} [expr [SortRandomNumber]/double(233280)] {} registrationPassword
StoreService registrationPassword $rep registrationPassword 1 1
} else {
# registrationPassword file already exists
if [LoadService $rep registrationPassword registrationPassword 1 1] {return} ;# corrupted password
}
set command [list list RegisterRepositoryName $rep $loCoInRep $registrationPassword $oldRegistrationPassword]
# MULTIPLE SUBMIT
set flag [MultipleExecute [list $urlibServerAddress] $command 1]
# set xxx --$flag--
# Store xxx C:/tmp/bbb auto 0 a
if [string equal {0} $flag] {
# registered
file delete $homePath/col/$rep/service/notRegistered
file delete $homePath/col/$rep/service/oldRegistrationPassword
} else {
# not registered
set notRegistered {}
Store notRegistered $homePath/col/$rep/service/notRegistered
lappend message "RegisterRepository ([clock format [clock seconds]]):"
lappend message [CallTrace]
lappend message [list flag == --$flag--]
set log [join $message \n]
# puts $log ;# didn't work on mtc-m17.sid.inpe.br
Store log $homePath/@errorLog auto 0 a
}
}
}
}
# RegisterRepository - end
# ----------------------------------------------------------------------
# ImportRepository
# remoteSiteAddress value is the http remote site address (without http://)
# the remote site is the site from which the repository will be imported
# if remoteSiteAddress is empty and repositoryName is the name of the packed repository
# in the current homePath/doc.zip then this repository is installed using this doc.zip
# repositoryName value is the name of the repository to be imported
# returns empty when the importation is made, othewise returns a non-empty error message
# administratorCodedPassword value is the administrator coded password
# startApacheServer value is 0 or 1; 1 (default) means to restart the Apache server
# Apache needs to be restarted when the repository contains a CGI script.
# If ImportRepository is called remotly under Unix, then Apache must be restarted outside
# ImportRepository (using the value 0 for startApacheServer) otherwise Submit called
# indirectly inside ImportRepository doesn't return.
# used only in CaptureRepository, SynchronizeRepository and Script (in repository: dpi.inpe.br/banon-pc@1905/2005/02.19.00.40)
# deletes download/doc.zip whenever the state value contains the word Modified (see ComputeVersionState)
proc ImportRepository {remoteSiteAddress repositoryName administratorCodedPassword {startApacheServer 1}} {
# runs with post
global homePath
global loCoInRep
global serveraddr
set message [CheckAdministratorPassword administrator $administratorCodedPassword]
if ![string equal {} $message] {return $message} ;# unfair call - don't import
if ![string equal {} $remoteSiteAddress] {
set remoteSite [GetServerAddressFromHTTPHost $remoteSiteAddress]
# versionState
# set versionState [Execute $remoteSiteAddress [list ComputeVersionState $repositoryName {} 1]] ;# returns empty (unless doing frame reload) communicating from banon-pc3 to plutao
# set versionState [Execute $remoteSiteAddress [list ComputeVersionState $repositoryName {} 1] 0] ;# not async - commented by GJFB in 2015-12-01 - doesn't work with virtual host
set versionState [Execute $remoteSite [list ComputeVersionState $repositoryName {} 1] 0] ;# not async - added by GJFB in 2015-12-01 - add the urlib port
# puts --$versionState-- ;# may contain an error message
# => {Registered Original} {banon-pc3 800} http://banon-pc3/rep-/dpi.inpe.br/banon/1999/12.15.21.29
if [string equal {} $versionState] {
return "the version state of the repository $repositoryName cannot be found"
}
foreach {versionState} $versionState {break}
# puts $versionState
array set stateTable {
{Registered Original} {Official}
{Modified Original} {Modified}
{Copy of an Original} {Copied}
{Modified Copy of an Original} {Modified}
{Unchecked} {Unchecked}
}
if [string equal {Modified} $stateTable($versionState)] {
return "the last update in the repository $repositoryName must be reloaded"
}
if ![Execute $remoteSite [list DownloadFileExists $repositoryName] 0] {
Execute $remoteSite [list MakeDownloadFile $repositoryName 0 0 0 administrator] 0 ;# not async - added by GJFB in 2018-01-02 - useful when synchronizing (see SynchronizeRepository) or importing (see administrator page) a repository
}
if 0 {
package require http
set fileId [open $homePath/doc.zip w]
set convertedURL [ConvertURLToHexadecimal http://$remoteSiteAddress/col/$repositoryName/download/doc.zip]
if [catch {http::geturl $convertedURL -channel $fileId} token] {
close $fileId
# Store token C:/tmp/bbb auto 0 a
file delete $homePath/doc.zip
return "token = $token" ;# don't import
} else {
close $fileId
# upvar #0 $token state
set ncode [::http::ncode $token]
# if ![string equal {HTTP/1.1 200 OK} $state(http)] #
if ![string equal {200} $ncode] {
# for example 404: HTTP/1.1 404 Not Found
# for example 401: HTTP/1.1 401 Authorization Required
file delete $homePath/doc.zip
if [string equal {401} $ncode] {
return "col/$repositoryName/download/doc.zip at $remoteSiteAddress doesn't have the 'allow from all' permission" ;# don't import
}
# set httpState $state(http)
set code [::http::code $token]
::http::cleanup $token ;# free memory including the array state
return "state(http) = $code" ;# don't import
}
http::cleanup $token
}
} else {
# new code by GJFB in 2015-08-25
set message [StoreURLContent http://$remoteSiteAddress/col/$repositoryName/download/doc.zip doc.zip]
if ![string equal {} $message] {return $message} ;# don't import
}
}
# INSTALL
# set command [InstallRepository 0 1 0 0 1]
# set command [InstallRepository 0 1 1 0 0 $repositoryName $administratorCodedPassword] ;# Apache needs to be restarted when the repository contains a CGI script
set command [InstallRepository 0 1 $startApacheServer 0 0 $repositoryName $administratorCodedPassword] ;# added by GJFB in 2013-12-02 in order to be able to postpone Apache server restarting in col/dpi.inpe.br/banon-pc@1905/2005/02.19.00.40/doc/cgi/script.tcl (see Import repository)
if [string equal {} $command] {
# installation made
# Append repNames to the repositoryListForStart file content
# (used to update keyRepositoryList in SetIndicator)
Load ../auxdoc/repositoryList repositoryList
set repNames [join $repositoryList \n]
Store repNames ../auxdoc/repositoryListForStart auto 0 a
# Append repNames to the repositoryListForStart file content - end
} elseif {[regexp {there is an original document} $command]} {
# already manually captured
return "there is an original document" ;# don't import
} else {
# unexpected repository
return "$command" ;# unexpected repository - don't import
}
}
# ImportRepository - end
# ----------------------------------------------------------------------
# CaptureRepository
# used by PerformCheck and Dialog (Host Collection option)
# return 0 if doc.zip has been captured and an error message otherwise
# >>> runs in the new host collection (B)
# remoteSiteStamp is of the old host collection (which are transferring the copyrights) (A)
# remoteVersionStamp is of the old host collection (which are transferring the copyrights) (A)
# Capture is allowed in accordance with the permissions contained in the file
# @sitesHavingReadPermission.txt
# registrationPassword is the repository registration password (stored in service)
proc CaptureRepository {rep metadataRep remoteSiteStamp registrationPassword remoteVersionStamp} {
# runs with post
global homePath
global loCoInRep
if [file isdirectory $homePath/col/$metadataRep] {
set versionStamp [GetVersionStamp $metadataRep]
if [string equal $remoteVersionStamp $versionStamp] {
# the repository has already be captured
return 0
}
}
# Test if the remote site is allowed to transfer copyright
# redundant code (already tested in Dialog by the host which is transferring the copyright)
set remoteServerAddress [lindex $remoteSiteStamp 0]
# remoteSite
set remoteSite [ReturnHTTPHost $remoteServerAddress]
# remoteHostCollection
set remoteHostCollection [lindex $remoteSiteStamp 1]
# remoteIp
set remoteIp [lindex $remoteSiteStamp 2]
# remoteServerAddressWithIP
foreach {m remoteURLibPort} [ReturnCommunicationAddress $remoteServerAddress] {break}
set remoteServerAddressWithIP [list $remoteIp $remoteURLibPort] ;# server address of the old host collection, ex.: {150.163.2.174 19050}
if [file exists $homePath/col/$loCoInRep/doc/@sitesAllowedToTransferCopyright.tcl] {
source $homePath/col/$loCoInRep/doc/@sitesAllowedToTransferCopyright.tcl
foreach name [array names allowedSitesArray $remoteHostCollection,*] {
regsub {.*,} $name {} name2 ;# ex: docpermission
set allowedSitesArray2($name2) $allowedSitesArray($name)
}
if ![info exists allowedSitesArray2] {return "CaptureRepository: the host collection $remoteHostCollection is not allowed to transfer copyright to the host collection $loCoInRep"}
} else {
return "CaptureRepository: file $homePath/col/$loCoInRep/doc/@sitesAllowedToTransferCopyright.tcl not found"
}
# Test if the remote site is allowed to transfer copyright - end
# the remote site (A) is allowed to transfer copyright to the current site (B)
# i.e., B accepts documents from A
# Waiting for the completion of other repository insertions
WaitQueue
# Waiting for the completion of other repository insertions - end
# IMPORT
# administratorCodedPassword
Load $homePath/col/$loCoInRep/auxdoc/xxx data binary
set data [UnShift $data]
set administratorCodedPassword [lindex $data end]
set command [ImportRepository $remoteSite $rep $administratorCodedPassword]
if [string equal {} $command] {
# importation made
# Process Permission
set allowedSitesList2 [array get allowedSitesArray2]
ProcessPermission $allowedSitesList2 $rep $metadataRep
# Process Permission - end
LeaveQueue
set transferableFlag 0 ;# must remain 0 in A
# Delete the remote host collection field (in A)
# SUBMIT
set message [Execute $remoteServerAddressWithIP [list UpdateHostCollectionFieldValue $rep $registrationPassword {} $transferableFlag]]
# set message [Execute $remoteServerAddressWithIP [list UpdateHostCollectionFieldValue $rep $registrationPassword {} $transferableFlag] 0] ;# not async
# Delete the remote host collection field - end
if [string equal {transferable} $message] {
# copyright can now be transferred again if necessary
set transferableFlag 1 ;# end of transfer; must be 1 in B
StoreService transferableFlag $rep transferableFlag 1 1
set metadataList {}
set metadata2List {}
UpdateMetadataField $metadataRep transferableflag $transferableFlag metadataList metadata2List 1
AddMetadata $metadataList
} else {
Store remoteServerAddressWithIP $homePath/col/$rep/service/transferNotCompleted
}
return 0
} elseif {[regexp {there is an original document} $command]} {
# already manually captured
LeaveQueue
return 0
} else {
LeaveQueue
return "CaptureRepository: command = $command"
}
# Capture the download/doc.zip which is in A - end
}
# CaptureRepository - end
# ----------------------------------------------------------------------
# CheckRegistration
# used twice by ControlBCButtonState
# return 0 while the registration process is turned off
## return 0 if the repository has been registered or
## need not be registered (because it contains an empty document or
## there is no domain name) and
## 1 otherwise
proc CheckRegistration {rep} {
global homePath
global environmentArray
return 0 ;# returns 0 while the registration process is turned off - RegisterRepositoryName need to be updated to include registration of copies (now a copy has an empty host collection value)
# return [expr ([file exists $homePath/col/$rep/service/notRegistered] || \
![file exists $homePath/col/$rep/service/registrationPassword]) && \
[file exists $homePath/col/$rep/service/size] && \
![string equal {} $environmentArray(domainName)]]
}
# CheckRegistration - end
# ----------------------------------------------------------------------
# UpdateHostCollectionFieldValue
# security issue
# used by TransferCopyright and cgi/script (in dpi.inpe.br/banon-pc@1905/2005/02.19.00.40)
# registrationPassword is the repository registration password (stored in service)
# newHostCollection is appended to the current hostCollection
# if newHostCollection is empty then service/hostCollection file is deleted (used in CaptureRepository)
# transferableFlag value is 0 or 1
# updates hostCollection value in service/hostCollection and repositoryProperties
proc UpdateHostCollectionFieldValue {rep registrationPassword newHostCollection transferableFlag} {
# runs with post
global homePath
# registrationPassword
if [LoadService $rep registrationPassword currentRegistrationPassword 1 1] {
# corrupted password
set log "UpdateHostCollectionFieldValue: $rep has a corrupted registration password"
puts $log
Store log $homePath/@errorLog auto 0 a
return $log
}
if ![string equal $registrationPassword $currentRegistrationPassword] {
# wrong registration password
set log "UpdateHostCollectionFieldValue: $rep has a wrong registration password"
puts $log
Store log $homePath/@errorLog auto 0 a
return $log
}
if ![file isdirectory $homePath/col/$rep] {return {transferable}} ;# the repository may have been deleted after a transfer - nothing to do
if [string equal {} $newHostCollection] {
file delete $homePath/col/$rep/service/hostCollection
# file delete $homePath/col/$rep/service/transferableFlag
} else {
# CONCAT
set hostCollection [LoadHostCollection $rep]
if [string equal $newHostCollection [lindex $hostCollection end]] {
set hostCollection2 $hostCollection ;# already updated (might occur after an error)
} else {
set hostCollection2 [concat $hostCollection $newHostCollection]
}
StoreHostCollection $rep $hostCollection2
StoreService transferableFlag $rep transferableFlag 1 1
}
UpdateRepositoryProperties $rep hostcollection
# metadataRep
set metadataRep [FindMetadataRep $rep]
# Update the hostcollection of the related metadata repositories
set metadataRepList [FindAllLanguageVersions $metadataRep]
foreach mRep $metadataRepList {
if [string equal {} $newHostCollection] {
file delete $homePath/col/$mRep/service/hostCollection
} else {
StoreHostCollection $mRep $hostCollection2
}
UpdateRepositoryProperties $mRep hostcollection
}
# Update the hostcollection of the related metadata repositories - end
if {$metadataRep != {}} {
set metadataList {}
set metadata2List {}
UpdateField $rep $metadataRep hostcollection metadataList metadata2List
UpdateMetadataField $metadataRep transferableflag $transferableFlag metadataList metadata2List 1
RemoveMetadata $metadata2List
AddMetadata $metadataList
}
UpdateRepositoryListForPost [concat $rep $metadataRepList]
return {transferable}
}
# UpdateHostCollectionFieldValue - end
# ----------------------------------------------------------------------
# UpdateOAIRepositoryData
# used in StartService and SPOK
proc UpdateOAIRepositoryData {} {
global OAIProtocolRepository
global loCoInRep
global homePath
# global OAISetSpecification ;# set here and used in CreateBriefEntry
# global referenceTypeList
# set serverAddress [GetServerAddress]
if [file isdirectory $homePath/col/$OAIProtocolRepository] {
# Migration 07/12/2003
if [file isdirectory $homePath/col/$loCoInRep/doc/OAI-PMH] {
file delete -force $homePath/col/$loCoInRep/doc/OAI-PMH
}
# Migration 07/12/2003 - end
file mkdir $homePath/col/$OAIProtocolRepository/auxdoc
if ![file exists $homePath/col/$OAIProtocolRepository/auxdoc/repositoryName.txt] {
set oaiRepositoryName "URLib local collection $loCoInRep"
Store oaiRepositoryName $homePath/col/$OAIProtocolRepository/auxdoc/repositoryName.txt
}
## if ![file exists $homePath/col/$OAIProtocolRepository/auxdoc/setSpecification.txt] {
## set setSpecification {Conference Proceedings
##Thesis}
# set setSpecification [join $referenceTypeList \n]
# Store setSpecification $homePath/col/$OAIProtocolRepository/auxdoc/setSpecification.txt
## }
# Load $homePath/col/$OAIProtocolRepository/auxdoc/setSpecification.txt OAISetSpecification
# set OAISetSpecification [split $OAISetSpecification \n]
# Migration 13/03/05
file delete $homePath/col/$OAIProtocolRepository/auxdoc/setSpecification.txt
# Migration 13/03/05
if ![file exists $homePath/col/$OAIProtocolRepository/auxdoc/siteList.txt] {
set siteList ""
Store siteList $homePath/col/$OAIProtocolRepository/auxdoc/siteList.txt
}
}
}
# UpdateOAIRepositoryData - end
# ----------------------------------------------------------------------
# StoreReadPermission
# used in Dialog, UpdateRepMetadataRep and CreateRepMetadataRep
# upperSuffix value is Permission or RemotePermission
# lowerSuffix value is permission or remotepermission
# title value is Permission or Remote Permission
# argument -> service -> repositoryProperties -> metadataList
# argument -> doc
proc StoreReadPermission {
xxDefaultPermissionName xxDocAccessPermissionName xxDownloadAccessPermissionName
rep metadataRep upperSuffix lowerSuffix secure title metadataListName metadata2ListName
} {
# runs with post and start
global homePath
upvar $xxDefaultPermissionName xxDefaultPermission
upvar $xxDocAccessPermissionName xxDocAccessPermission
upvar $xxDownloadAccessPermissionName xxDownloadAccessPermission
upvar $metadataListName metadataList
upvar $metadata2ListName metadata2List
# puts [CallTrace]
# puts --$xxDocAccessPermission--
# set startApacheServer 0
if $xxDefaultPermission {
file delete $homePath/col/$rep/service/doc$upperSuffix
if [Info exists repositoryProperties($rep,doc$lowerSuffix)] {
Unset repositoryProperties($rep,doc$lowerSuffix)
# set startApacheServer [expr !$secure]
}
file delete $homePath/col/$rep/service/download$upperSuffix
if [Info exists repositoryProperties($rep,download$lowerSuffix)] {
Unset repositoryProperties($rep,download$lowerSuffix)
# set startApacheServer [expr !$secure]
}
if [string equal {Permission} $title] {
if {$metadataRep != {}} {
DeleteMetadataField $metadataRep readpermission \
metadata2List 1
}
}
} else {
# Convert to one host per line
set xxDocAccessPermission [Convert2OneHostPerLine $xxDocAccessPermission]
# Convert to one host per line - end
LoadService $rep doc$upperSuffix oldXXDocAccessPermission $secure 1
StoreService xxDocAccessPermission $rep doc$upperSuffix $secure 1
if {$oldXXDocAccessPermission == {} || \
$oldXXDocAccessPermission != "$xxDocAccessPermission"} {
Eval UpdateRepositoryProperties $rep doc$lowerSuffix
# set startApacheServer [expr !$secure]
}
# Convert to one host per line
set xxDownloadAccessPermission [Convert2OneHostPerLine $xxDownloadAccessPermission]
# Convert to one host per line - end
LoadService $rep download$upperSuffix oldXXDownloadAccessPermission $secure 1
StoreService xxDownloadAccessPermission $rep download$upperSuffix $secure 1
if {$oldXXDownloadAccessPermission == {} || \
$oldXXDownloadAccessPermission != "$xxDownloadAccessPermission"} {
Eval UpdateRepositoryProperties $rep download$lowerSuffix
# set startApacheServer [expr !$secure]
}
if [string equal {Permission} $title] {
if {$metadataRep != {}} {
set xxDocAccessPermission2 [string trim $xxDocAccessPermission \n] ;# added by GJFB in 2011-04-10
regsub -all "\n" $xxDocAccessPermission2 { and } value
UpdateMetadataField $metadataRep readpermission $value metadataList metadata2List 1
}
}
}
# return $startApacheServer
return 0 ;# because of the access file use
}
# StoreReadPermission - end
# ----------------------------------------------------------------------
# UpdateAccessFile
# creates, updates or deletes the .htaccess file
# called in UpdateRepMetadataRep
proc UpdateAccessFile {rep} {
# runs with post and start
global homePath
global environmentArray
# global applicationName
global loCoInRep
# administratorUserName
regsub {@.*$} $environmentArray(spMailEntry) {} administratorUserName
# ipAddress
set ipAddress $environmentArray(ipAddress)
# compute default access
foreach {defaultAuthenticationFlag spDocAccessPermission spDownloadAccessPermission directivesForCGI} [ComputeDefaultAccess $ipAddress 1] {break}
# compute access
foreach {authDirectives docPermission downloadPermission} [Eval ComputeAccess $rep $administratorUserName $defaultAuthenticationFlag $spDocAccessPermission $spDownloadAccessPermission $ipAddress 1] {break}
# puts [list $authDirectives $docPermission $downloadPermission]
# doc
if {![string equal {} $docPermission] || ![string equal {} $authDirectives]} {
set fileContent "Satisfy any$docPermission$authDirectives"
if [file isdirectory $homePath/col/$rep/doc] {
Store fileContent $homePath/col/$rep/doc/.htaccess
}
} else {
file delete $homePath/col/$rep/doc/.htaccess
}
if ![string equal {} $docPermission] {
set fileContent $docPermission
if [file isdirectory $homePath/col/$rep/doc] {
Store fileContent $homePath/col/$rep/doc/.htaccess2
}
} else {
file delete $homePath/col/$rep/doc/.htaccess2
}
# download
if {![string equal {} $downloadPermission] || ![string equal {} $authDirectives]} {
set fileContent "Satisfy any$downloadPermission$authDirectives"
file mkdir $homePath/col/$rep/download
Store fileContent $homePath/col/$rep/download/.htaccess
} else {
file delete $homePath/col/$rep/download/.htaccess
}
if ![string equal {} $downloadPermission] {
set fileContent $downloadPermission
file mkdir $homePath/col/$rep/download
Store fileContent $homePath/col/$rep/download/.htaccess2
} else {
file delete $homePath/col/$rep/download/.htaccess2
}
# Restrict access to update and review
if 0 {
if {$applicationName == "post"} {
# Info doesn't work when UpdateAccessFile is called from a cgi script (Get or Get-) (with mtc-m19)
global repositoryProperties
set flag [info exists repositoryProperties($rep,username)]
} else {
set flag [Info exists repositoryProperties($rep,username)]
}
} else {
# if is now in Info
set flag [Info exists repositoryProperties($rep,username)]
}
if $flag {
file mkdir $homePath/col/$rep/auxdoc/cgi2
set fileContent \
"
allow from all
"
Store fileContent $homePath/col/$rep/auxdoc/cgi2/.htaccess
set fileContent \
"
allow from all
"
Store fileContent $homePath/col/$rep/auxdoc/cgi2/.htaccess2
} else {
file delete $homePath/col/$rep/auxdoc/cgi2/.htaccess
file delete $homePath/col/$rep/auxdoc/cgi2/.htaccess2
}
if [file exists $homePath/col/$rep/auxdoc/cgi3/review] {
if {![string equal {} $authDirectives] && !$defaultAuthenticationFlag} {
set fileContent \
"
AuthName \"URLib Update Form\"
AuthType Basic
AuthUserFile \"$homePath/col/$loCoInRep/auxdoc/@passwords.txt\"$authDirectives
satisfy any
"
Store fileContent $homePath/col/$rep/auxdoc/cgi3/.htaccess
} else {
# don't display review
file delete $homePath/col/$rep/auxdoc/cgi3/.htaccess
}
}
# Restrict access to update and review - end
}
# UpdateAccessFile - end
# ----------------------------------------------------------------------
# SetAccessPermission
# used in UpdateRepMetadataRep and CreateRepMetadataRep
# doesn't change xxDefaultPermission
# content equivalence for readPermission: ip <==> deny from all and allow from ip
proc SetAccessPermission {
rep readPermission xxDefaultPermissionName
xxDocAccessPermissionName xxDownloadAccessPermissionName
} {
# runs with post and start
global repositoryProperties ;# used when UpdateRepMetadataRep is calling
upvar $xxDefaultPermissionName xxDefaultPermission
upvar $xxDocAccessPermissionName xxDocAccessPermission
upvar $xxDownloadAccessPermissionName xxDownloadAccessPermission
# puts --$readPermission--
if $xxDefaultPermission {
set xxDocAccessPermission {} ;# used in CreateRepMetadataRep - added by GJFB in 2011-06-13 to avoid: can't read "xxDocAccessPermission": no such variable while executing "regexp {deny} $xxDocAccessPermission"
} else {
if [regexp {from} $readPermission] {
regsub -all { and } $readPermission "\n" xxDocAccessPermission
} else {
if [string equal {intranet} $readPermission] {
# runs with post only
# metadataRep
set metadataRep [FindMetadataRep $rep]
# year
set year [GetFieldValue $metadataRep-0 year]
# group
set group [GetFieldValue $metadataRep-0 group]
# ipList
# puts "[list ReturnIntranetConfiguration $year $group]"
if [catch {ReturnIntranetConfiguration $year $group} ipList] {
set xxDocAccessPermission "deny from all"
} else {
if [string equal {} $ipList] {
set xxDocAccessPermission "deny from all"
} else {
set xxDocAccessPermission "deny from all
allow from $ipList"
}
}
} else {
set xxDocAccessPermission "deny from all
allow from $readPermission"
}
}
if [info exists repositoryProperties($rep,downloadpermission)] {
set xxDownloadAccessPermission $repositoryProperties($rep,downloadpermission)
} else {
set xxDownloadAccessPermission "deny from all"
}
if [regexp {^ *deny +from +all *$} $xxDocAccessPermission] {
set xxDownloadAccessPermission "deny from all"
} elseif ![regexp {^ *allow +from +all *$} $xxDocAccessPermission] {
# there are some restrictions
if ![regexp {^ *deny +from +all *$} $xxDownloadAccessPermission] {
set xxDownloadAccessPermission $xxDocAccessPermission
}
}
}
}
# SetAccessPermission - end
# ----------------------------------------------------------------------
# UpdateRepositoryListForPost
# repositoryListForPost contains the list of repositories
# that have been created, updated or deleted during the
# current posting
proc UpdateRepositoryListForPost {repList} {
# runs with post
global repositoryListForPost
global repositoryListForStart
global saveMetadata
if ![info exists repositoryListForPost] {set repositoryListForPost {}}
set repositoryListForPost [concat $repositoryListForPost $repList]
set repositoryListForPost [lsort -unique $repositoryListForPost]
if {[llength $repositoryListForPost] > 200} {
# to speed up the next repository creations
SaveRepositoryProperties 1
SaveReferenceTable 1
set saveMetadata 1
SaveMetadata 1
set repositoryListForStart {}
if [file exists ../auxdoc/.repositoryListForStart.tcl] {
source ../auxdoc/.repositoryListForStart.tcl ;# set the variable repositoryListForStart
}
set repositoryListForStart [concat $repositoryListForPost $repositoryListForStart]
set repositoryListForStart [lsort -unique $repositoryListForStart]
StoreList repositoryListForStart ../auxdoc/.repositoryListForStart.tcl
file delete ../auxdoc/.repositoryListForPost.tcl
unset repositoryListForPost
} else {
StoreList repositoryListForPost ../auxdoc/.repositoryListForPost.tcl
}
# set xxx [CallTrace]
# Store xxx C:/tmp/bbb auto 0 a
}
if 0 {
source utilitiesStart.tcl
UpdateRepositoryListForPost dpi.inpe.br/banon/1998/08.02.08.56
}
# UpdateRepositoryListForPost - end
# ----------------------------------------------------------------------
# TransferCopyright
# >>> runs in the old host collection (A)
# transferts copyright from A to B
# used by Dialog
# rep value is the name of the repository to be transferred
# remoteSiteStamp value is the stamp of the site receiving the copyright (B)
# save value is 0 or 1,
# 1 means to update and save the metadata
# example of @sitesAllowedToTransferCopyright.tcl content:
if 0 {
array set allowedSitesArray {
bighost.com.br/banon/2005/05.04.18.04,defaultpermission {0}
bighost.com.br/banon/2005/05.04.18.04,docpermission {{allow from all}}
bighost.com.br/banon/2005/05.04.18.04,downloadpermission {{deny from all} {allow from 127.0.0.1} {allow from 192.168.1.100} {allow from 150.163.2.174}}
bighost.com.br/banon/2005/05.04.18.04,mirrorsites {bighost.com.br/banon/2005/05.04.18.04}
bighost.com.br/banon/2005/05.04.18.04,defaultremotepermission {0}
bighost.com.br/banon/2005/05.04.18.04,docremotepermission {{allow from all}}
bighost.com.br/banon/2005/05.04.18.04,downloadremotepermission {{deny from all}}
}
}
# The allowed sites must be in accordance with the permissions contained in the file
# @sitesHavingReadPermission.txt (otherwise CaptureRepository is not executed)
# username must be administrator or the administrator name
# The administrator must have been registered as an advanced user (otherwise CaptureRepository is not executed)
proc TransferCopyright {rep metadataRep remoteSiteStamp userName} {
# runs with post
global homePath
global URLibServiceRepository
global repositoryProperties
global environmentArray
global startApacheServer
global tcl_platform
# administratorUserName
regsub {@.*$} $environmentArray(spMailEntry) {} administratorUserName
if ![string equal administrator $userName] {
if [string equal $administratorUserName $userName] {
# $userName is the administrator
} else {
# $userName is not the administrator
return "TransferCopyright (1): '$userName' is not the administrator"
}
}
set metadataList {}
set metadata2List {}
# remoteHostCollection (B)
set remoteHostCollection [lindex $remoteSiteStamp 1]
if 0 {
if ![GetDocumentState $rep 1] {
# don't transfer - the repository doesn't contain the original document
return {TransferCopyright: the repository doesn't contain the original document}
}
}
if ![file exists $homePath/col/$rep/service/notCaptured] {
if [string equal $repositoryProperties($rep,hostcollection) $remoteHostCollection] {
# don't transfer - the remote host collection is the current one
return {the remote host collection is the current one}
}
}
# Capure @sitesAllowedToTransferCopyright.tcl
# remoteServerAddress
set remoteServerAddress [lindex $remoteSiteStamp 0] ;# server address of the new host collection
# remoteSite
set remoteSite [ReturnHTTPHost $remoteServerAddress]
# remoteIp
set remoteIp [lindex $remoteSiteStamp 2]
# siteStamp (A)
set siteStamp [lrange [GetSiteStamp] 0 2]
# Store siteStamp C:/tmp/bbb auto 0 a
# localHostCollection (A)
set localHostCollection [lindex $siteStamp 1] ;# == loCoInRep
# set xxx http://$remoteSite/col/$remoteHostCollection/doc/%40sitesAllowedToTransferCopyright.tcl
# Store xxx C:/tmp/bbb auto 0 a
set convertedURL [ConvertURLToHexadecimal http://$remoteSite/col/$remoteHostCollection/doc/@sitesAllowedToTransferCopyright.tcl]
if [catch {http::geturl $convertedURL} token] {
# don't transfer - unknown host collection
# global errorInfo
# return "$token $errorInfo"
return {unknown host}
} else {
upvar #0 $token state
if ![string equal {HTTP/1.1 200 OK} $state(http)] {
# for example: HTTP/1.1 404 Not Found
http::cleanup $token
return {@sitesAllowedToTransferCopyright.tcl not found or permission denied}
}
# the file exists in the remoteSite and can be reached (there no access restriction)
eval [http::data $token] ;# creates allowedSitesArray
http::cleanup $token
}
foreach name [array names allowedSitesArray $localHostCollection,*] {
regsub {.*,} $name {} name2 ;# ex: docpermission
set allowedSitesArray2($name2) $allowedSitesArray($name)
}
# Capure @sitesAllowedToTransferCopyright.tcl - end
if ![info exists allowedSitesArray2] {return {site not allowed to transfer copyright}}
TestUpdateLastUpdate $rep $metadataRep 0 $administratorUserName ;# must be before the host collection change below
# registrationPassword
if ![file exists $homePath/col/$rep/service/registrationPassword] {
# registrationPassword file doesn't exist
# CREATE registrationPassword
regsub {0\.} [expr [SortRandomNumber]/double(233280)] {} registrationPassword
StoreService registrationPassword $rep registrationPassword 1 1
} else {
# registrationPassword file already exists
if [LoadService $rep registrationPassword registrationPassword 1 1] {
# corrupted password
return "$rep has a corrupted registration password"
}
}
# Update the host collection field value
# A -> A B
set transferableFlag 0 ;# beginning of transfer ; must remain 0 in A for ever and 0 in B as long as the transfer is not completed
# UpdateHostCollectionFieldValue $rep $metadataRep $registrationPassword $remoteHostCollection $transferableFlag
UpdateHostCollectionFieldValue $rep $registrationPassword $remoteHostCollection $transferableFlag ;# updates hostCollection value in service/hostCollection and repositoryProperties
# Update the host collection field value - end
# localIp
set localIp $environmentArray(ipAddress)
# Update permissions
# Process Mirror Sites
if [file exists $homePath/col/$rep/service/mirrorSites] {
file delete $homePath/col/$rep/service/mirrorSites
UpdateRepositoryProperties $rep mirrorsites
if [file exists $homePath/col/$rep/download/doc.zip] {
# doc.zip must exist, otherwise zip returns: zip warning: name not matched: col/iconet.com.br/banon/2003/03.31.16.30/service/mirrorSites
set message [UpdateArchiveFile $rep col/$rep/service/mirrorSites -d]
if ![string equal {} $message] {return "TransferCopyright (2): $message"}
}
}
# Process Mirror Sites - end
# Process Remote Permission
set remotePermission [join [list {deny from all} "allow from $remoteIp" "allow from $localIp"] \n]
LoadService $rep docRemotePermission oldRemotePermission 1 1
if ![string equal $remotePermission $oldRemotePermission] {
StoreService remotePermission $rep docRemotePermission 1 1
UpdateRepositoryProperties $rep docremotepermission
}
LoadService $rep downloadRemotePermission oldRemotePermission 1 1
if ![string equal $remotePermission $oldRemotePermission] {
StoreService remotePermission $rep downloadRemotePermission 1 1
UpdateRepositoryProperties $rep downloadremotepermission
}
# set xxx $repositoryProperties($rep,downloadremotepermission)
# Store xxx C:/tmp/bbb auto 0 a
SaveRepositoryProperties
# Process Remote Permission - end
# set startApacheServer 1
# StartApacheServer ;# doesn't work with solaris - the remote call to the procedure TransferCopyright doesn't finish
if {$tcl_platform(platform) == "unix"} {
# not tested
# if [file owned $homePath/col/$rep/download] {exec chmod 775 $homePath/col/$rep/download}
}
Store remotePermission $homePath/col/$rep/download/.htaccess
# Update permissions - end
## Migration 3/3/03
# file delete $homePath/col/$rep/service/password
## Migration 3/3/03 - end
if [file exists $homePath/col/$rep/service/userName] {
set userName $repositoryProperties($rep,username)
file delete $homePath/col/$rep/service/userName
UpdateRepositoryProperties $rep username
if [file exists $homePath/col/$rep/download/doc.zip] {
# doc.zip must exist, otherwise zip returns: zip warning: name not matched: col/iconet.com.br/banon/2003/03.31.16.30/service/userName
if [string equal {administrator} $userName] {
# userName is in doc.zip if and only if user name is administrator (see MakeDownloadFile)
set message [UpdateArchiveFile $rep col/$rep/service/userName -d]
if ![string equal {} $message] {return "TransferCopyright (3): $message"}
}
}
}
# Update download files
# UpdateDownloadFilesByAdministrator $rep 1
if ![file exists $homePath/col/$rep/download/doc.zip] {
UpdateDownloadFilesByAdministrator $rep ;# pack doc
}
UpdateDownloadFilesByAdministrator $rep 2 ;# pack everything except doc
# add hostCollection and transferableFlag
if [file exists $homePath/col/$rep/service/hostCollection] {
set message [UpdateArchiveFile $rep [list col/$rep/service/hostCollection col/$rep/service/transferableFlag]]
if ![string equal {} $message] {return "TransferCopyright (4): $message"}
}
set metadataRepList [FindAllLanguageVersions $metadataRep]
foreach mRep $metadataRepList {
if [file exists $homePath/col/$mRep/service/hostCollection] {
set message [UpdateArchiveFile $rep col/$mRep/service/hostCollection]
if ![string equal {} $message] {return "TransferCopyright (5): $message"}
}
}
# Update download files - end
# Ask to capture the repository in this local collection
# regexp {:(.*)} $remoteSite m serverPort
# set remoteHostCollectionServerAddress $remoteIp:$serverPort ;# server address of the new host collection, ex.: 150.163.8.245:1905
# Store remoteHostCollectionServerAddress $homePath/col/$rep/service/notRemotelyRegistered
# Store remoteServerAddress $homePath/col/$rep/service/notRemotelyRegistered
foreach {m remoteURLibPort} [ReturnCommunicationAddress $remoteServerAddress] {break}
set remoteServerAddressWithIP [list $remoteIp $remoteURLibPort] ;# server address of the new host collection, ex.: {150.163.2.174 19050}
if [file exists $homePath/col/$rep/service/notCaptured] {
# a copyright transfer may have been done but (A) receives a premature return of CaptureRepository
# because the transfer lasts longer than the MultipleExecute time-out
set versionStamp [GetVersionStamp $metadataRep]
} else {
set versionStamp {}
}
# MULTIPLE SUBMIT
# set command [list list CaptureRepository $rep $metadataRep $siteStamp $registrationPassword]
set command [list list CaptureRepository $rep $metadataRep $siteStamp $registrationPassword $versionStamp]
# set flag [MultipleExecute [list $remoteHostCollectionServerAddress] $command]
# set flag [MultipleExecute [list $remoteServerAddress] $command]
set flag [MultipleExecute [list $remoteServerAddressWithIP] $command]
# puts --$flag--
if [string equal {0} $flag] {
# captured
file delete $homePath/col/$rep/service/notCaptured ;# (A)
if 0 {
# Process Remote Permission
file delete $homePath/col/$rep/service/docRemotePermission
Eval UpdateRepositoryProperties $rep docremotepermission
file delete $homePath/col/$rep/service/downloadRemotePermission
Eval UpdateRepositoryProperties $rep downloadremotepermission
# Process Remote Permission - end
}
} else {
# not captured
# Store remoteHostCollectionServerAddress $homePath/col/$rep/service/notCaptured
# Store remoteServerAddress $homePath/col/$rep/service/notCaptured
# Store remoteServerAddressWithIP $homePath/col/$rep/service/notCaptured
Store remoteSiteStamp $homePath/col/$rep/service/notCaptured ;# (A)
return "TransferCopyright: --$flag--" ;# this message is interpreted in Dialog (utilities2.tcl)
}
# captured
file delete $homePath/col/$rep/download/doc.zip ;# this doc.zip is just for transferring the copyrights
file delete $homePath/col/$rep/download/.htaccess
file delete -force $homePath/col/$rep/auxdoc/cgi2 ;# may contain the update file
# Process Permission
set allowedSitesList2 [array get allowedSitesArray2]
ProcessPermission $allowedSitesList2 $rep $metadataRep
# Process Permission - end
# Ask to capture the repository in this local collection - end
# UpdateRepositoryListForPost [concat $rep $metadataRepList]
UpdateRepositoryListForPost [concat $rep $metadataRep]
# SAVE - end
}
# TransferCopyright - end
# ----------------------------------------------------------------------
# UpdateArchiveFile
# updates the download/doc.zip file within rep
# used in TransferCopyright
# fileNameList is a list of path names (beginning with col) of the files to be updated (or deleted)
# option value is empty or -d (for delete)
# example: UpdateArchiveFile iconet.com.br/banon/2003/03.31.16.30 col/iconet.com.br/banon/2003/03.31.16.30/service/mirrorSites -d
# if done, returns empty, otherwise returns an error message
proc UpdateArchiveFile {rep fileNameList {option {}}} {
global homePath
global zipPath
global pwd
cd $homePath
if [catch {eval "exec \"$zipPath\" $option \"$homePath/col/$rep/download/doc.zip\" $fileNameList"} message] {
cd $pwd
return "UpdateArchiveFile: $message"
}
cd $pwd
}
# UpdateArchiveFile - end
# ----------------------------------------------------------------------
# ProcessPermission
# used in UpdateHostCollectionFieldValue and CaptureRepository only
proc ProcessPermission {allowedSitesList2 rep metadataRep} {
# runs with post
global homePath
array set allowedSitesArray2 $allowedSitesList2
set metadataList {}
set metadata2List {}
set defaultPermission $allowedSitesArray2(defaultpermission)
set docPermission [join $allowedSitesArray2(docpermission) \n]
set downloadPermission [join $allowedSitesArray2(downloadpermission) \n]
StoreReadPermission defaultPermission docPermission downloadPermission \
$rep $metadataRep \
Permission permission 0 Permission metadataList metadata2List
set defaultRemotePermission $allowedSitesArray2(defaultremotepermission)
set docRemotePermission [join $allowedSitesArray2(docremotepermission) \n]
set downloadRemotePermission [join $allowedSitesArray2(downloadremotepermission) \n]
StoreReadPermission defaultRemotePermission docRemotePermission downloadRemotePermission \
$rep $metadataRep \
RemotePermission remotepermission 1 {Remote Permission} metadataList metadata2List
RemoveMetadata $metadata2List
AddMetadata $metadataList
# SAVE
set saveMetadata 1
SaveMetadata
# Store read permission - end
# Store mirrorSites
if ![string equal {} $allowedSitesArray2(mirrorsites)] {
if 0 {
set mirrorSites {}
foreach item $allowedSitesArray2(mirrorsites) {
lappend mirrorSites [lindex $item 1]
}
}
set mirrorSites $allowedSitesArray2(mirrorsites)
StoreService mirrorSites $rep mirrorSites 1 1
} else {
file delete $homePath/col/$rep/service/mirrorSites
}
UpdateRepositoryProperties $rep mirrorsites
SaveRepositoryProperties
# Store mirrorSites - end
UpdateAccessFile $rep
}
# ProcessPermission - end
# ----------------------------------------------------------------------
# SetAdvancedUserFromUserGroup
# set an advanced user from the user group
## and update the reader group by concatenating to it the user group
# use as advanced user name the first name
# in the usergroup field which is not administrator
# used only by the cgi script in dpi.inpe.br/banon-pc@1905/2005/02.19.00.40
# password must be coded
proc SetAdvancedUserFromUserGroup {rep userName password} {
# runs with post
global homePath
# metadataRep
set metadataRep [FindMetadataRep $rep]
# userGroup
set userGroup [GetFieldValue $metadataRep-0 usergroup]
# advancedUserName
if ![string equal {} $userGroup] {
foreach user $userGroup {
if ![string equal {administrator} $user] {break}
}
set advancedUserName $user
} else {
return "usergroup is empty"
}
## readerGroup
# set readerGroup [GetFieldValue $metadataRep-0 readergroup]
# set readerGroup [concat $readerGroup $userGroup] ;# add userGroup (useful for 8ICSHMO)
# set readerGroup [lsort -unique $readerGroup]
set return [MakeCgiScript2 $rep $userName $password]
if ![string equal {} $return] {return $return}
# remove
set metadata2List [GetMetadata $metadataRep-0,username]
# set metadata2List [concat $metadata2List [GetMetadata $metadataRep-0,readergroup]]
# add
set metadataList [list $metadataRep-0,username $advancedUserName]
# set metadataList [concat $metadataList [list $metadataRep-0,readergroup $readerGroup]]
LoadService $rep userName oldUserName 1 1
#
# doesn't append the user name to the user group (this is done in Dialog (see utilities2.tcl) not in this procedure)
#
# Update history
# CREATE A NEW VERSION STAMP (for the metadata repository (metadataRep))
set seconds [clock seconds]
if [string equal {} $oldUserName] {set oldUserName administrator}
Load $homePath/col/$metadataRep/doc/@metadata.refer referMetadata
set metadataVersionStamp [CreateVersionStamp $seconds $oldUserName $referMetadata] ;# it is assumed that the administrator acts on behalf of the old user
UpdateHistory $metadataRep $metadataVersionStamp
# Update history - end
# remove
set metadata2List [concat $metadata2List [GetMetadata $metadataRep-0,metadatalastupdate]]
# add
set metadataList [concat $metadataList [list $metadataRep-0,metadatalastupdate $metadataVersionStamp]]
StoreService advancedUserName $rep userName 1 1
# Store readerGroup $homePath/col/$rep/service/authenticatedUsers
UpdateRepositoryProperties $rep username
UpdateRepositoryProperties $rep authenticatedusers
UpdateAccessFile $rep
RemoveMetadata $metadata2List
AddMetadata $metadataList
set repositoryList $rep
lappend repositoryList $metadataRep
UpdateRepositoryListForPost $repositoryList
}
# SetAdvancedUserFromUserGroup - end
# ----------------------------------------------------------------------
# ManageLogFile
# Leaves the log file size not greater than 200000 bytes
# absolutePath is absolute path of the log file
# the log file name must be without file type or with file type .log
# examples:
# ManageLogFile $homePath/@errorLog
# ManageLogFile $homePath/col/$loCoInRep/auxdoc/@actionLog - added by GJFB in 2017-11-18
# ManageLogFile $homePath/col/$URLibServiceRepository/auxdoc/serverDir/logs/access.log
# ManageLogFile $homePath/col/$URLibServiceRepository/auxdoc/serverDir/logs/error.log
proc ManageLogFile {absolutePath} {
global tcl_platform
global errorInfo
global homePath
global loCoInRep
global URLibServiceRepository
# Log migration - 2015-11-14
if 0 {
if ![file isdirectory $homePath/col/$loCoInRep/doc/URLibServiceLog] {
file mkdir $homePath/col/$loCoInRep/doc/URLibServiceLog
set path $homePath/@errorLog
foreach item [glob -nocomplain $path*] {
if [regexp "^$path\\d+$" $item] {
file rename $item $homePath/col/$loCoInRep/doc/URLibServiceLog/[file tail $item]
}
}
}
if ![file isdirectory $homePath/col/$loCoInRep/doc/ApacheLog] {
file mkdir $homePath/col/$loCoInRep/doc/ApacheLog
set rootPath $homePath/col/$URLibServiceRepository/auxdoc/serverDir/logs/access
foreach item [glob -nocomplain $rootPath*] {
if [regexp "^$rootPath\\d+\\.log$" $item] {
file rename $item $homePath/col/$loCoInRep/doc/ApacheLog/[file tail $item]
}
}
set rootPath $homePath/col/$URLibServiceRepository/auxdoc/serverDir/logs/error
foreach item [glob -nocomplain $rootPath*] {
if [regexp "^$rootPath\\d+\\.log$" $item] {
file rename $item $homePath/col/$loCoInRep/doc/ApacheLog/[file tail $item]
}
}
}
}
# Log migration - 2015-11-14 - end
if [catch {set size [file size $absolutePath]}] {return}
if [expr $size < 200000] {return}
# if [expr $size < 2000] {return} ;# for testing
if [regexp {(.*)\.log$} $absolutePath m rootPath] {
# file type is .log
# ApacheLog
# $homePath/col/$URLibServiceRepository/auxdoc/serverDir/logs/access.log -> $homePath/col/$loCoInRep/doc/ApacheLog/access
set root [file tail $rootPath] ;# access or error
set absolutePath2 $homePath/col/$loCoInRep/doc/ApacheLog/$root
set lastLogFile [lindex [lsort -dictionary [glob -nocomplain $absolutePath2*.log]] end]
# fileNumber
if [string equal {} $lastLogFile] {
set fileNumber 0
} else {
regexp "${absolutePath2}(.*).log$" $lastLogFile m fileNumber
}
incr fileNumber
if [catch {file rename $absolutePath $absolutePath2$fileNumber.log}] {
# on Windows one may get a "permission denied" while apache is running
set log "\[[clock format [clock seconds] -format %Y:%m.%d.%H.%M.%S]\] ManageLogFile: the following error has been catched:\n\"$errorInfo\"\n"
puts $log
Store log $homePath/@errorLog auto 0 a
}
} else {
# file type is not .log
# URLibServiceLog
# $homePath/@errorLog -> $homePath/col/$loCoInRep/doc/URLibServiceLog/@errorLog
# set absolutePath2 $homePath/col/$loCoInRep/doc/URLibServiceLog/@errorLog ;# commented by GJFB in 2017-11-18
set root [file tail $absolutePath] ;# @errorLog or @actionLog - added by GJFB in 2017-11-18
set absolutePath2 $homePath/col/$loCoInRep/doc/URLibServiceLog/$root ;# added by GJFB in 2017-11-18
set lastLogFile [lindex [lsort -dictionary [glob -nocomplain $absolutePath2*]] end]
# fileNumber
if [string equal {} $lastLogFile] {
set fileNumber 0
} else {
regexp "${absolutePath2}(.*)$" $lastLogFile m fileNumber
}
incr fileNumber
file rename $absolutePath $absolutePath2$fileNumber
if {$tcl_platform(platform) == "unix"} {
set log {}
Store log $absolutePath
exec chmod g+w $absolutePath ;# needed by some cgi scripts writing in @errorLog
}
}
}
# ManageLogFile - end
# ----------------------------------------------------------------------
# ListIntersection
# used in Search
proc ListIntersection {list1Name list2Name} {
upvar $list1Name list1
upvar $list2Name list2
set list {}
foreach element $list1 {
if {[lsearch -exact $list2 $element] >= 0} {
lappend list $element
}
}
return $list
}
# ListIntersection - end
# ----------------------------------------------------------------------
# ListNegatedImplication
# used in Script within dpi.inpe.br/banon-pc@1905/2005/02.19.00.40 (administrator page)
# used in RemoveMetadata and AddMetadata
# not (list1 -> list2) == (list1 and not list2) == (list1 - list2)
# list1Name and list2Name must not be list of lists (because of split/join)
proc ListNegatedImplication {list1Name list2Name} {
upvar $list1Name list1
upvar $list2Name list2
if [string equal {} $list2] {return $list1} ;# added by GJFB in 2010-12-10
set list {}
# split and join below are to solve error like list element in quotes followed by "," instead of space
# example:
# split {data "aaa", were}
# => data {"aaa",} were
# join {data {"aaa",} were}
# => data "aaa", were
foreach element [split $list1] {
if {[lsearch -exact [split $list2] $element] < 0} {
lappend list $element
}
}
return [join $list]
}
# ListNegatedImplication - end
# ----------------------------------------------------------------------