#!/bin/sh
# The next line is executed by /bin/sh, but not tcl \
exec tclsh "$0" ${1+"$@"}
##
## httppost.tcl
##
## Post to a web page and return data
##
if {0} {
##
## EXAMPLES
##
# Uploading a PTS file: (only the file as a Data elem is needed)
httppost.tcl http://pop/~hobbs/wis/cgi-bin/pq.cgi
-user <valid-user> -passwd <users-passwd> \
-file Data <PTS_data.txt> var value var value
}
package require Tcl 8.2
package require http 2.2
#package require base64; # from tcllib - only needed for user/passwd
# it gets called below when necessary
proc Usage {} {
puts stderr "[file tail $::argv0] URL \\
?-proxyhost domain? \\
?-proxyport port? \\
?-user user? \\
?-passwd passwd? \\
?-output outputFile? \\
?-file formElemName fileName? \\
formElemName value formElemName value ...
-proxyhost and -proxyport set the proxy to use, if necessary
-user and -passwd are required if the URL requires authentication
files are handled specially with -file as the file has to
be read in and then that is used as the value."
exit
}
proc process {} {
global argv
if {[llength $argv] < 4} {
Usage
}
set opts(URL) [lindex $argv 0]
set argv [lrange $argv 1 end]
set opts(FILE) [list]
while {[string match -* [lindex $argv 0]]} {
switch -exact -- [lindex $argv 0] {
-proxyhost {
set opts(PROXYHOST) [lindex $argv 1]
if {![info exists opts(PROXYPORT)]} {
set opts(PROXYPORT) 80
}
set argv [lrange $argv 2 end]
}
-proxyport {
set opts(PROXYPORT) [lindex $argv 1]
set argv [lrange $argv 2 end]
}
-user {
set opts(USER) [lindex $argv 1]
set argv [lrange $argv 2 end]
}
-passwd {
set opts(PASSWD) [lindex $argv 1]
set argv [lrange $argv 2 end]
}
-file {
lappend opts(FILE) [lindex $argv 1] [lindex $argv 2]
set argv [lrange $argv 3 end]
}
-output {
set opts(OUTFILE) [lindex $argv 1]
set argv [lrange $argv 2 end]
}
default {
Usage
}
}
}
if {[info exists opts(PROXYHOST)]} {
::http::config -proxyhost $opts(PROXYHOST) \
-proxyport $opts(PROXYPORT)
}
## Configure the output channel
set outfd stdout
set type "multipart/form-data"
if {[info exists opts(OUTFILE)]} {
set outfd [open $opts(OUTFILE) w]
}
fconfigure $outfd -translation binary
set outputData {}
set bound "-----NEXT_PART_[clock seconds].[pid]"
foreach {elem file} $opts(FILE) {
set fid [open $file r]
fconfigure $fid -translation binary
if {[catch {read $fid [file size $file]} data]} {
return -code error $data
}
close $fid
append outputData "--$bound\nContent-Disposition: form-data;\
name=\"$elem\"; filename=\"[file tail $file]\"\n\n$data\n"
}
foreach {elem data} $argv {
append outputData "$bound\nContent-Disposition: form-data;\
name=\"$elem\"\n\n$data\n"
}
if {![string length $outputData]} {
return -code error "No data given to post"
}
append outputData "${bound}--"
set request [list ::http::geturl $opts(URL) \
-channel $outfd \
-type "multipart/form-data; boundary=$bound" \
-query $outputData]
if {[info exists opts(USER)] && [info exists opts(PASSWD)]} {
package require base64
lappend request -headers [list Authorization \
"Basic [base64::encode $opts(USER):$opts(PASSWD)]"]
}
set token [eval $request]
::http::wait $token
if {[string compare stdout $outfd]} {
close $outfd
}
}
process
