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
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
|
<HTML><HEAD>
<TITLE>Examples -- Example 7: wincgi</TITLE>
<LINK rel=Previous href="tcl-app7.htm">
<LINK rel=ToC href="toc.htm">
<LINK rel=Index href="master.htm">
<LINK rel=Next href="tcldev
.htm">
</HEAD><BODY BGCOLOR="#ffffff"><A NAME="topofpage"></A>
<TABLE WIDTH=100%>
<TR>
<TD ALIGN=LEFT>
<A NAME="topofpage"></A> <IMG SRC="as-c-sm.gif">
</TD>
<TD ALIGN=RIGHT>
<A href="tcl-app7.htm"><IMG BORDER="0" src=navbprev.gif alt="[ Previous ]"></A>
<A href=toc.htm> <IMG BORDER="0" src=navbhome.gif alt="[ Contents ]"></A>
<A href=master.htm> <IMG BORDER="0" src=navbhelp.gif alt="[ Index ]"></A>
<A href="tcldev
.htm"> <IMG BORDER="0" src=navbnext.gif alt="[ Next ]"></A>
<A name="7983"> </A>
</TD>
</TR>
</TABLE>
<a name="18410">
</a><h3>Example 7: wincgi</h3>
<p><a name="18411">
</a>The following example script is a simple emulation of the WebSite WinCGI interface.</p>
<p><a name="18412">
</a>This example can be found in the <code>examples/tcl/wincgi.tcl</code> file.</p>
<pre> <a name="18413"></a>
<a name="19186"></a>#
<a name="19192"></a># Example 7: simple emulation of the WebSite WinCGI interface
<a name="19187"></a>#
<a name="18985"></a># This Tcl script emulates the WinCGI interface of the WebSite server.
<a name="18986"></a># To use, move this file to your Tcl library directory (normally the
<a name="18987"></a># modules/tcl directory of the AOLserver directory), set the
<a name="18988"></a># following nsd.ini variables in the [ns\server\<server-name>\wincgi]
<a name="18989"></a># section, and restart the server.
<a name="18990"></a>#
<a name="18991"></a># key default description
<a name="18992"></a># --- ------- -----------
<a name="18993"></a># prefix /cgi-win URL prefix for WinCGI.
<a name="18994"></a># debug off Set to on to keep temp files for debugging.
<a name="18995"></a># gmtoff 0 Minutes West of GMT for the "GMT Offset" variable.
<a name="18996"></a># dir c:\wincgi Directory of WinCGI programs.
<a name="18997"></a>#
<a name="18998"></a>#
<a name="18999"></a># Note: This script is unsupported and not a complete emulation of the
<a name="19000"></a># WebSite WinCGI interface. In particular, not all the WinCGI variables
<a name="19001"></a># are set. Full support for WinCGI will be incorporated into the nscgi
<a name="19002"></a># module in a future AOLserver release.
<a name="19003"></a>#
<a name="19004"></a>
<a name="19005"></a>#
<a name="19006"></a># Fetch the variables from the configuration file.
<a name="19007"></a>#
<a name="19008"></a>global WinCGI
<a name="19009"></a>set WinCGI(section) "ns\\server\\[ns_info server]\\wincgi"
<a name="19010"></a>if {[set WinCGI(prefix) [ns_config $WinCGI(section) prefix]] == ""} {
<a name="19011"></a> set WinCGI(prefix) /cgi-win
<a name="19012"></a>}
<a name="19013"></a>if {[set WinCGI(dir) [ns_config $WinCGI(section) dir]] == ""} {
<a name="19014"></a> set WinCGI(dir) [ns_info home]/$WinCGI(prefix)
<a name="19015"></a>}
<a name="19016"></a>if {[set WinCGI(gmtoff) [ns_config $WinCGI(section) gmtoff]] == ""} {
<a name="19017"></a> set WinCGI(gmtoff) 0
<a name="19018"></a>}
<a name="19019"></a>if {[set WinCGI(debug) [ns_config -bool $WinCGI(section) debug]] == ""} {
<a name="19020"></a> set WinCGI(debug) 0
<a name="19021"></a>}
<a name="19022"></a>
<a name="19023"></a>
<a name="19024"></a>
<a name="19182"></a>
<a name="19183"></a>
<a name="19184"></a>#
<a name="19025"></a># Register the win-cgi procedure to handle requests for WinCGI executables.
<a name="19026"></a>#
<a name="19027"></a>ns_register_proc POST $WinCGI(prefix)/*.exe win-cgi
<a name="19028"></a>ns_register_proc GET $WinCGI(prefix)/*.exe win-cgi
<a name="19029"></a>
<a name="19030"></a>
<a name="19031"></a>#
<a name="19032"></a># win-cgi - The Tcl request procedure which emulates WinCGI.
<a name="19033"></a>#
<a name="19034"></a>proc win-cgi {conn ignored} {
<a name="19035"></a> global WinCGI
<a name="19036"></a>
<a name="19037"></a> # The program is the second part of the WinCGI URL.
<a name="19038"></a> set args [join [split [ns_conn query $conn] &]]
<a name="19039"></a> set pgm [lindex [ns_conn urlv $conn] 1]
<a name="19040"></a> regsub -all {\+} $args " " args
<a name="19041"></a> foreach e [split $WinCGI(dir)/$pgm /] {
<a name="19042"></a> if {$e != ""} {lappend exec $e}
<a name="19043"></a> }
<a name="19044"></a> set exec [join $exec \\]
<a name="19045"></a> if ![file executable $exec] {
<a name="19046"></a> return [ns_returnnotfound $conn]
<a name="19047"></a> }
<a name="19048"></a>
<a name="19049"></a> # WinCGI requires a few temporary files.
<a name="19050"></a> set ini [ns_tmpnam]
<a name="19051"></a> set inp [ns_tmpnam]
<a name="19052"></a> set out [ns_tmpnam]
<a name="19053"></a>
<a name="19054"></a> # Copy the request content to the input file.
<a name="19055"></a> set fp [open $inp w]
<a name="19056"></a> ns_writecontent $conn $fp
<a name="19057"></a> set len [tell $fp]
<a name="19058"></a> close $fp
<a name="19059"></a>
<a name="19060"></a> # Create the WinCGI variables .ini file.
<a name="19061"></a> set fp [open $ini w]
<a name="19062"></a> puts $fp {[CGI]}
<a name="19063"></a> puts $fp \
<a name="19064"></a>"Request Protocol=HTTP/1.0
<a name="19065"></a>Request Method=[ns_conn method $conn]
<a name="19066"></a>Executable Path=$WinCGI(prefix)/$pgm
<a name="19067"></a>Server Software=[ns_info name]/[ns_info version]
<a name="19068"></a>Server Name=[ns_info name]
<a name="19069"></a>Server Port=[ns_info version]
<a name="19070"></a>Server Admin=[ns_config AOLserver WebMaster]
<a name="19071"></a>CGI Version=CGI/1.2 (Win)
<a name="19072"></a>Remote Address=[ns_conn peeraddr $conn]
<a name="19073"></a>Authentication Method=Basic
<a name="19074"></a>Authentication Realm=[ns_conn location $conn]
<a name="19075"></a>Content Type=application/x-www-form-urlencoded
<a name="19076"></a>Content Length=$len"
<a name="19077"></a> puts $fp ""
<a name="19078"></a> puts $fp {[System]}
<a name="19079"></a> puts $fp \
<a name="19080"></a>"GMT Offset=$WinCGI(gmtoff)
<a name="19081"></a>Debug Mode=Yes
<a name="19082"></a>Output File=$out
<a name="19083"></a>Content File=$inp"
<a name="19084"></a>
<a name="19085"></a> # Set any POST or query form variables.
<a name="19086"></a> puts $fp ""
<a name="19087"></a> puts $fp {[Form Literal]}
<a name="19088"></a> set form [ns_conn form $conn]
<a name="19089"></a> if {$form != ""} {
<a name="19090"></a> for {set i 0} {$i < [ns_set size $form]} {incr i} {
<a name="19091"></a> set key [ns_set key $form $i]
<a name="19092"></a> set value [ns_set value $form $i]
<a name="19093"></a> puts $fp "$key=$value"
<a name="19094"></a> }
<a name="19095"></a> }
<a name="19096"></a>
<a name="19097"></a> # Set the accept headers and accumulate the extra headers.
<a name="19098"></a> puts $fp ""
<a name="19099"></a> puts $fp {[Accept]}
<a name="19100"></a> set headers [ns_conn headers $conn]
<a name="19101"></a> set extras ""
<a name="19102"></a> for {set i 0} {$i < [ns_set size $headers]} {incr i} {
<a name="19103"></a> set key [ns_set key $headers $i]
<a name="19104"></a> set ukey [string toupper $key]
<a name="19105"></a> set value [ns_set value $headers $i]
<a name="19106"></a> if {$ukey == "ACCEPT"} {
<a name="19107"></a> puts $fp "$value=Yes"
<a name="19108"></a> } elseif {$key != "CONTENT-LENGTH" && $key != "CONTENT-TYPE"} {
<a name="19109"></a> append extras "$key=$value\n"
<a name="19110"></a> }
<a name="19111"></a> }
<a name="19112"></a> puts $fp ""
<a name="19113"></a> puts $fp {[Extra Headers]}
<a name="19114"></a> puts $fp $extras
<a name="19115"></a> close $fp
<a name="19116"></a>
<a name="19117"></a> # Execute the WinCGI program.
<a name="19118"></a> # NB: "catch" the exec and open because a WinCGI
<a name="19119"></a> # program can be misbehaved, returning a non-zero
<a name="19120"></a> # exit status or not creating the output file.
<a name="19121"></a> catch {exec "$exec $ini $inp $out $args"}
<a name="19122"></a> if [catch {set fp [open $out]}] {
<a name="19123"></a> ns_returnerror $conn 500 "WinCGI exec failed"
<a name="19124"></a> } else {
<a name="19125"></a> set type text/html
<a name="19126"></a> set status 200
<a name="19127"></a> while {[gets $fp line] > 0} {
<a name="19128"></a> set line [string trim $line]
<a name="19129"></a> if {$line == ""} break
<a name="19130"></a> set head [split $line :]
<a name="19131"></a> set key [string tolower [string trim [lindex $head 0]]]
<a name="19132"></a> set value [string trim [lindex $head 1]]
<a name="19133"></a> if {$key == "content-type"} {
<a name="19134"></a> set type $value
<a name="19135"></a> } elseif {$key == "location"} {
<a name="19136"></a> set location $value
<a name="19137"></a> } elseif {$key == "status"} {
<a name="19138"></a> set status $status
<a name="19139"></a> }
<a name="19140"></a> }
<a name="19141"></a> set page [read $fp]
<a name="19142"></a> close $fp
<a name="19143"></a>
<a name="19144"></a> if [info exists location] {
<a name="19145"></a> ns_returnredirect $conn $location
<a name="19146"></a> } else {
<a name="19147"></a> ns_return $conn $status $type $page
<a name="19148"></a> }
<a name="19149"></a> }
<a name="19150"></a>
<a name="19151"></a> if $WinCGI(debug) {
<a name="19152"></a> ns_log Notice "CGI $pgm: ini: $ini, inp: $inp, out: $out"
<a name="19153"></a> } else {
<a name="19154"></a> ns_unlink -nocomplain $ini
<a name="19155"></a> ns_unlink -nocomplain $inp
<a name="19156"></a> ns_unlink -nocomplain $out
<a name="19157"></a> }
<a name="19158"></a>}
<a name="19159"></a>
<a name="18306"></a>
</pre><p>
<TABLE BORDER="2" CELLPADDING="1" width="100%">
<TR><TD COLSPAN=3><P ALIGN=Center>
<IMG SRC="bluebult.gif">
<A HREF="#topofpage">
<FONT SIZE=-1>Top of Page</FONT></A>
<IMG SRC="bluebult.gif">
</TD></TR>
<TR><TD COLSPAN=3><P ALIGN=Center>
<A href="tcl-app7.htm">
<IMG BORDER="0" src=navbprev.gif alt="[ Previous ]"></A>
<A href=toc.htm>
<IMG BORDER="0" src=navbhome.gif alt="[ Contents ]"></A>
<A href=master.htm>
<IMG BORDER="0" src=navbhelp.gif alt="[ Index ]"></A>
<A href="tcldev
.htm">
<IMG BORDER="0" src=navbnext.gif alt="[ Next ]"></A>
<BR align=center>
<FONT size=-1>Copyright © 1998-99 America Online,
Inc.</FONT>
</TD></TR></TABLE></BODY></HTML>
|
