Welcome, guest | Sign In | My Account | Store | Cart

The following script does general http posting and has support for uploading of files as well. It does this by sending the data as "multipart/form-data".

Tcl, 142 lines
  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
#!/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

The main body of the procedure is placed in the "process" procedure in order to gain some advantage from Tcl's byte-code compiler, which doesn't compile toplevel code (with the assumption that it only runs once).

You will need the base64 package from tcllib (part of ActiveTcl) only if you are using the standard user/password authentication.

3 comments

Stefan Vogel 19 years, 2 months ago  # | flag

Small typo in script. Please correct the missing "--" right before the boundary for additional key-value pairs (I've stumbled over that error the second time now) ;-)

Must be:

foreach {elem data} $argv {

# pay attention to "--"

append outputData "--$bound\nContent-Disposition: form-data;\

 name=\"$elem\"\n\n$data\n"

}

amel amel 17 years, 4 months ago  # | flag

it doesn't work. hello, i'm interrested by your scripts. It's the aim of my developpment. I try it with my parameters.It works but without sending datas. Can you help. thank you

edwin bermudez 14 years, 11 months ago  # | flag

it doesn't work. hello, i'm interrested by your scripts. It's the aim of my developpment. I try it with my parameters.It works but without sending datas of the second foreach:

foreach {elem data} $argv {

pay attention to "--"

append outputData "--$bound\nContent-Disposition: form-data;\

name=\"$elem\"\n\n$data\n"

}

That values are passed "elem", "data" to this foreach???

Can you help. thank you, my email is bermudezdouglas@hotmail.com

Thanks Douglas Aparicio

Created by Jeff Hobbs on Thu, 24 Jan 2002 (MIT)
Tcl recipes (162)
Jeff Hobbs's recipes (16)

Required Modules

  • (none specified)

Other Information and Tasks