diff options
Diffstat (limited to 'web/cgi/alpine/2.0/conduit/export')
| -rwxr-xr-x | web/cgi/alpine/2.0/conduit/export | 168 |
1 files changed, 168 insertions, 0 deletions
diff --git a/web/cgi/alpine/2.0/conduit/export b/web/cgi/alpine/2.0/conduit/export new file mode 100755 index 00000000..42a9f82b --- /dev/null +++ b/web/cgi/alpine/2.0/conduit/export @@ -0,0 +1,168 @@ +#!./tclsh +# $Id: export 391 2007-01-25 03:53:59Z mikes@u.washington.edu $ +# ======================================================================== +# Copyright 2006 University of Washington +# +# Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at +# +# http://www.apache.org/licenses/LICENSE-2.0 +# +# ======================================================================== + +# export +# +# Purpose: CGI script to download exported folder +# +# Input: +set export_vars { +} + +#set export_via_ip_address 1 +#set export_via_local_hostname 1 + +# inherit global config +source ../alpine.tcl + +set mailextension ".mbx" + +proc WPServerIP {} { + global _wp + + catch { + set ip 127.0.0.1 + set sid [socket -async [info hostname] [expr {([string length $_wp(serverport)]) ? $_wp(serverport) : 80}]] + set ip [lindex [ fconfigure $sid -sockname ] 0] + close $sid + } + + return $ip +} + + +WPEval $export_vars { + # grok PATH_INFO for collection 'c' and folder 'f' uid 'u' and part 'p' + if {!([info exists env(PATH_INFO)] && [string length $env(PATH_INFO)] + && [regexp {^/([0-9]+)/(.*)$} $env(PATH_INFO) dummy c f])} { + WPCmd PEInfo statmsg "Invalid Detach: $env(SCRIPT_NAME)" + cgi_exit + } + + # generate filenames to hold exported folder and control file + for {set n 0} {1} {incr n} { + + set rhandle [WPCmd PESession random 64] + set cfile [file join $_wp(fileroot) $_wp(detachpath) detach.${rhandle}-control] + set dfile [file join $_wp(fileroot) $_wp(detachpath) detach.${rhandle}-data] + + if {[file exists $cfile] == 0 && [file exists $dfile] == 0} { + if {[catch {open $cfile {RDWR CREAT EXCL} [cgi_tmpfile_permissions]} cfd] + || [catch {open $dfile {RDWR CREAT EXCL} [cgi_tmpfile_permissions]} dfd]} { + if {[info exists dfd]} { + catch {close $cfd} + catch {file delete -force $cfile} + set errstr $dfd + } else { + set errstr $cfd + } + + error [list _action Export "Cannot create command/control files: [cgi_quote_html $errstr]" "Please close this window"] + } else { + close $dfd + break + } + } elseif {$n > 4} { + error [list _action Export "Command file creation limit" "Please close this window"] + } + } + + catch {file delete $dfile} + + if {[catch {WPCmd PEFolder export $c $f $dfile} result]} { + WPCmd PEInfo statmsg $result + } else { + if {[set dfilesize [file size $dfile]] > 0 + && ([info exists _wp(uplim_bytes)] && $_wp(uplim_bytes) > 0) + && $dfilesize > $_wp(uplim_bytes)} { + if {$_wp(uplim_bytes) > (1000000)} { + set dfs [format {%s.%.2s MB} [WPcomma [expr {$dfilesize / 1000000}]] [expr {$dfilesize % 1000000}]] + set esl [format {%s.%.2s MB} [WPcomma [expr {$_wp(uplim_bytes) / 1000000}]] [expr {$_wp(uplim_bytes) % 1000000}]] + } else { + set dfs "[WPcomma $dfs] KB" + set esl "[WPcomma $_wp(uplim_bytes)] KB" + } + + WPCmd PEInfo statmsg "Exported folder size ($dfs) exceeds the maximum ($esl) size that can be imported.<br>If you wish to import this folder back into Web Alpine at a later time,<br>you should break it up into smaller folders" + } + + if {[info exists export_via_ip_address]} { + if {[regsub {^(http[s]?://)[A-Za-z0-9\\-\\.]+(.*)$} "[cgi_root]/pub/getach.tcl" "\\1\[[WPServerIP]\]\\2" redirect] != 1} { + WPCmd PEInfo statmsg "Cannot determine server address" + catch {unset redirect} + } + } elseif {[info exists export_via_local_hostname]} { + if {[regsub {^(http[s]?://)[A-Za-z0-9\\-\\.]+(.*)$} "[cgi_root]/pub/getach.tcl" "\\1\[[info hostname]\]\\2" redirect] != 1} { + WPCmd PEInfo statmsg "Cannot determine server address" + catch {unset redirect} + } + } else { + set redirect "[cgi_root]/pub/getach.tcl" + } + + set givenname "[file tail $f]${mailextension}" + set safegivenname $givenname + regsub -all {[/]} $safegivenname {-} safegivenname + regsub -all {[ ]} $safegivenname {_} safegivenname + regsub -all {[\?]} $safegivenname {X} safegivenname + regsub -all {[&]} $safegivenname {X} safegivenname + regsub -all {[#]} $safegivenname {X} safegivenname + regsub -all {[=]} $safegivenname {X} safegivenname + set safegivenname "/$safegivenname" + + puts $cfd "Content-type: Application/X-Mail-Folder" + puts $cfd "Content-Disposition: attachment; filename=\"$givenname\"" + + # side-step the cgi_xxx stuff in this special case because + # we don't want to buffer up the downloading attachment... + + puts $cfd "Content-Length: $dfilesize" + puts $cfd "Expires: [clock format [expr {[clock seconds] + 3600}] -f {%a, %d %b %Y %H:%M:%S GMT} -gmt true]" + puts $cfd "Cache-Control: max-age=3600" + puts $cfd "" + + puts $cfd $dfile + + # exec chmod [cgi_tmpfile_permissions] $dfile + + close $cfd + + exec /bin/chmod [cgi_tmpfile_permissions] $cfile + exec /bin/chmod [cgi_tmpfile_permissions] $dfile + } + + # prepare to clean up if the brower never redirects + if {[info exists redirect]} { + set redirect "${redirect}${safegivenname}?h=${rhandle}" + } else { + set redirect "[cgi_root]/$_wp(appdir)/$_wp(ui2dir)/folders/" + } + + cgi_http_head { + # redirect to the place we stuffed the export info. use the ip address + # to foil spilling any session cookies or the like + + if {[info exists env(SERVER_PROTOCOL)] && [regexp {[Hh][Tt][Tt][PP]/([0-9]+)\.([0-9]+)} $env(SERVER_PROTOCOL) m vmaj vmin] && $vmaj >= 1 && $vmin >= 1} { + cgi_puts "Status: 303 Temporary Redirect" + } else { + cgi_puts "Status: 302 Redirected" + } + + cgi_puts "URI: $redirect" + cgi_puts "Location: $redirect" + } + + cgi_body {} + + exec echo $rhandle | [file join $_wp(cgipath) [WPCmd PEInfo set wp_ver_dir] whackatch.tcl] >& /dev/null & +} |