# Copyright for the Uniform Repository Service (c) 1995 - 2020,
# by Gerald Banon. All rights reserved.
# Version 2.1
# archive.tcl

# cgi inputs used by Archive:
# username
# codedpassword1

# example of use:
# http://gprb0705.sid.inpe.br/archive.cgi/urlib.net/www/2011/03.08.19.56
# http://mtc-m21b.sid.inpe.br/archive.cgi/sid.inpe.br/mtc-m21b/2014/08.29.12.56.41
# http://mtc-m05.sid.inpe.br/archive.cgi/sid.inpe.br/iris@1905/2005/08.03.22.04

proc Archive {} {
if [catch {
	global env
	global cgi	;# used in CheckUsernamePasswordForm
	global homePath	;# used in ReturnZipPath and MakeArchive
	global serverAddress	;# used in SetFieldValue
	global URLibServiceRepository	;# added by GJFB in 2020-04-18 - used in DirectoryMTime
	
	fconfigure stdout -translation binary

	set col ../../../../..
	set URLibServiceRepository $env(URLIB_SERVICE_REP)
	source ../$col/$URLibServiceRepository/doc/utilities1.tcl
	source ../$col/$URLibServiceRepository/doc/cgi/mirrorfind-.tcl

# homePath
	set homePath $env(DOCUMENT_ROOT)
# serverAddress
	set serverAddress [list $env(SERVER_NAME) $env(URLIB_PORT)]
# serverAddressWithIP
	set serverAddressWithIP [list $env(IP_ADDR) $env(URLIB_PORT)]	;# used in CheckUsernamePasswordForm only
# pathInfo
	set pathInfo [file split $env(PATH_INFO)]
# currentRep
	regsub -all { } [lrange $pathInfo 1 4] {/} currentRep
# dir
	set dir $homePath/col/$currentRep/doc
# loCoInRep
	set loCoInRep $env(LOCOINREP)
	
# Security issue
# otherwise the archive directory could be created at a wrong place in system file
	if ![file isdirectory $dir] {
		puts {Content-Type: text/html}
		puts {}
		puts "Archive: $currentRep is not a repository in the current local collection."
		return
	}
	if [string equal $currentRep $loCoInRep] {
		puts {Content-Type: text/html}
		puts {}
		puts "Archive: for security reason no arquive.zip created, $currentRep is the local collection index $loCoInRep and cannot be downloaded."
		return
	}
# Security issue - end

# Check permission
	set metadataRep [Execute $serverAddress [list FindMetadataRep $currentRep]]
#	SetFieldValue $serverAddress $metadataRep-0 {readpermission readergroup contenttype}
	SetFieldValue $serverAddress $metadataRep-0 {readpermission contenttype}
	if {[regexp {deny} $readpermission] && ![string equal {Template} $contenttype]} {
		if [info exists env(QUERY_STRING)] {
			foreach {name value} [split $env(QUERY_STRING) &=] {
				set cgi([DecodeURL $name]) [DecodeURL $value]
			}
		}
#		if {[info exists cgi(username)] && [lsearch $readergroup $cgi(username)] != -1 && \
			[info exists cgi(codedpassword1)]} #
		if {[info exists cgi(username)] && [info exists cgi(codedpassword1)]} {
# Check password
			set {unknown username} {unknown username}	;# used in CheckUsernamePasswordForm
			set {empty password} {empty password}	;# used in CheckUsernamePasswordForm
			set {wrong password} {wrong password}	;# used in CheckUsernamePasswordForm
			set message [CheckUsernamePasswordForm]
			if ![string equal {} $message] {
				puts {Content-Type: text/html}
				puts {}
				puts "Archive: $message."
				return
			}
# Check password - end
		} else {
			puts {Content-Type: text/html}
			puts {}
			puts "Archive: permission denied."
			return
		}
	}
# Check permission - end

	set fileList {}
	DirectoryContent fileList $dir $dir
	
# Count one click
	set URParts [file split $currentRep]
	set localURLibClientSocketId [StartCommunication $env(SERVER_NAME) $env(URLIB_PORT)]
	set clientIPAddress [GetClientIP]	;# added by GJFB in 2020-09-07 
	Submit $localURLibClientSocketId [list PostponeOneClickCount $URParts $clientIPAddress]	;# second argument added by GJFB in 2020-09-07
	close $localURLibClientSocketId
# Count one click - end

	if {[llength $fileList] == 1} {
		set fileName [lindex $fileList 0]
		Load $homePath/col/$currentRep/doc/$fileName fileContent binary
		puts "Content-disposition: attachment; filename=\"$fileName\""
		puts {}
		puts $fileContent
	} else {
		MakeArchive $currentRep fileList
		Load $homePath/col/$currentRep/archive/archive.zip fileContent binary
		puts "Content-disposition: attachment; filename=archive.zip"
		puts {}
		puts $fileContent
	}

} m] {
	if ![string equal {} $m] {
		puts {Content-Type: text/html}
		puts {}
		puts $m
		if 0 {global errorInfo; puts $errorInfo}
	}
}
}