# Copyright for the Uniform Repository Service (c) 1995 - 2023 # by Gerald Banon. All rights reserved. # Version 2.1 # attachment.tcl # examples of use: # http://gprb0705.sid.inpe.br/attachment.cgi/urlib.net/www/2011/03.08.19.56/doc/bib/publicacao.bib # http://gjfb.home/attachment.cgi/urlib.net/www/2014/01.08.02.07/doc/carta/VP - PLC 14 - 13 versão final - Executivo. doc.doc proc Attachment {} { if [catch { global env global serverAddress ;# used in SetFieldValue 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 if 0 { puts {Content-Type: text/html} puts {} } # serverAddress set serverAddress [list $env(SERVER_NAME) $env(URLIB_PORT)] # pathInfo set pathInfo [file split $env(PATH_INFO)] # puts $pathInfo # => / dpi.inpe.br banon 1999 01.09.22.14 doc ApacheLog access1.log # currentRep regsub -all { } [lrange $pathInfo 1 4] {/} currentRep # sixthItem set sixthItem [lindex $pathInfo 6] # loCoInRep set loCoInRep $env(LOCOINREP) # Check permission set metadataRep [Execute $serverAddress [list FindMetadataRep $currentRep]] SetFieldValue $serverAddress $metadataRep-0 {readpermission contenttype} set permission allow if {[regexp {deny} $readpermission] && ![string equal {Template} $contenttype]} { set permission deny set ipList [ExtractIPList $readpermission] foreach ip $ipList { if [regexp $ip $env(REMOTE_ADDR)] { set permission allow break } } } # Check permission - end # if [string equal {deny} $permission] # ;# commented by GJFB in 2018-02-08 # if {[regexp {deny} $permission] || \ # ([string equal {CGI Script} $contenttype] && [string equal {cgi} $sixthItem]) || \ # ([string equal $loCoInRep $currentRep] && [regexp {^(ApacheLog|URLibServiceLog)$} $sixthItem])} # ;# added by GJFB in 2018-02-08 to avoid code display - commented by GJFB in 2023-03-16 if {[regexp {deny} $permission] || \ ([string equal {CGI Script} $contenttype] && [string equal {cgi} $sixthItem])} { ;# added by GJFB in 2018-02-08 to avoid code display and in 2023-03-16 because the files ApacheLog and URLibServiceLog are now in auxdoc puts {Content-Type: text/html} puts {} puts "Attachment: permission denied." return } # homePath set homePath $env(DOCUMENT_ROOT) # pathInfo set splitedPathInfo [file split $env(PATH_INFO)] # currentRep set filePath [eval file join [lrange $splitedPathInfo 1 end]] ;# drop the first component (/) set fileName [file tail $env(PATH_INFO)] Load $homePath/col/$filePath fileContent binary puts "Content-disposition: attachment; filename=\"$fileName\"" puts {} puts $fileContent } m] { if ![string equal {} $m] { puts {Content-Type: text/html} puts {} puts $m if 0 {global errorInfo; puts $errorInfo} } } }