diff options
Diffstat (limited to 'web/src/cgi.tcl-1.10')
57 files changed, 10913 insertions, 0 deletions
diff --git a/web/src/cgi.tcl-1.10/HISTORY b/web/src/cgi.tcl-1.10/HISTORY new file mode 100644 index 00000000..3fc80020 --- /dev/null +++ b/web/src/cgi.tcl-1.10/HISTORY @@ -0,0 +1,644 @@ +This is the HISTORY file for cgi.tcl. + +Date Version Description +------- ------- ------------------------------------------------------ +5/1/05 1.10.0 Odd Arne Jensen <odd@bibsyst.xno> observed that <input>-related + tags were producing </input> which is forbidden by the HTML + spec. We agreed to go with .../> for max compatibility with + both HTML and XHTML. + + Noticed hackers submitting filenames with leading hyphens to + display to do interesting things. It did fail gracefully + fortunately but it shouldn't fail at all. Added -- to switch. + + Evan Mezeske <emezeske@enflex.xnet> recommended settable limits + on file uploads to avoid denial-of-service attacks. Added + cgi_file_limit. + +12/14/05 1.9.0 Tore Morkemo noted backward test in cgi_noscript used puts + instead of cgi_puts. + + Aravindo Wingeier <wingeier@glue.ch> provided patches to choose + an encoding or use UTF-8 encoding by default. + + Rolf Ade <pointsmen@gmx.xnet> noted an initialization proc + would be useful for things like tclhttpd. + + Modified display.cgi to deal more gracefully with people + experimenting with tildes. + + De Clarke noted cgi_input failed if whitespace appeared in a + client filename. Due to assumption that Content-Disposition + line would be a proper list. + + De also noted that lynx simply wasn't providing quotes in + multipart input variable names. Relaxed code to accept that. + + De also noted that the binary file upload wasn't working in + pre-Tcl 8.1 but neither of us were interested in spending the + time to find out why. Unless someone bothers to figure it, for + now, I'm just dropping support for such old versions. + + Due to DoC policy, changed cookie example from persistent to + non-persistent. + + Added utf.cgi example to demonstrate UTF works for + mel@redolive.com. + +10/16/02 1.8.0 To accomodate open-ended forms in echo, modified cgi_input so + that it accepts multiple values even in variables that don't + end with "List". This opens a possible ambiguity (see + documentation) but only one that would've existed before had + the diagnostic not prevented it. + + Added example: echo.cgi + + Added cgierror anchor to cgi_eval. + + Tian-Hsiang Huang <xiang@phys.ncku.edu.tw> noted bug in testing + for error of passwd.cgi example. + +4/27/02 1.7.0 David Kuehling <dvdkhlng@gmx.de> noted that cgi_content_type + needed to protect args in call to cgi_http_head. + +4/15/02 1.6.1 Darren New fixed my attempt at 1.6.0! + +4/15/02 1.6.0 Darren New <dnew@san.rr.com> noted that quote_url needed to + translate +. + +3/16/02 1.6.0 Added test for checked=bool to radio/checkbox to avoid having + user have to do "eval ... [expr ...?"checked":""]" nonsense. + + Added version.cgi script to make it easier for people to figure + out whether examples on NIST server are using the same version + of cgi.tcl that they're using. + + Tore Morkemo noted backward test in cgi_refresh. + +9/19/01 1.5.0 De Clarke noted that file upload broke with Opera. Problem + was lack of a \r at the end of the input file. At the same + time protected regexp-specials in the boundary string. + Both of were due to unusual but legal interpretations. + + Added HELO interaction to smtp dialogue. + + Jonathan Lennox <lennox@cs.columbia.edu> provided fix for + finding sendmail on BSD 4.4 systems. + + Modified cgi_html and _start to support optional attributes. + + Extended auto-attr quoting for XHTML support. + Added end tags for XHTML support. + + Added cgi_link_url/label per John Koontz and rewrote cgi_link + to accomodate them. Also added his cgi_button_link + temporarily. Will experiment with this to test merit. + +11/3/00 1.4.3 Removed HTML formatted manual. It lags the text version and + just caused more confusion than it's worth. + +11/2/00 1.4.2 John Koontz observed that the versions between home page and + package didn't match. Added version.in to fix this once and + for all. + +10/19/00 1.4.1 Carlos Vidal <carlos@tarkus.se> fixed cgi_cookie_get -all. + + Anton Osennikov <ant@ccl.ru> provided patch to propagate + errorCode back through cgi_body. + + Fixed display_in_frame to allow app_body_end to execute. + +6/14/00 1.4.0 Tomas Soucek requested a mechanism for saving content-type + from file uploads. Seemed appropriate to do this by renaming + cgi_import_filename to ..._file and adding -type flag. + + Petrus Vloet noted vote.cnt missing from distrib. He also + noted getting warnings regarding missing newlines. + +5/19/00 1.3.0 Changed many cgi_puts to cgi_put in hopes of addressing more + of Zygo's 5/9/00 complaint (i.e., same problem in tables). + +5/9/00 1.2.2 Zygo Blaxell <zblaxell@feedme.hungrycats.org> provided signif. + cgi_input regexp speedup for long x=y-style values. He also + noted that some browsers are sensitive to leading/following + \n's in textarea and provided a patch to avoid adding them in + the first place. + + James Ward <jew@rincon.com> noted absence of pkgIndex.tcl + (presumably due to really old Tcl) broke installation. Fixed + pkgcreate to create stub file to allow Make to complete. + + Robin Lauren <robin.lauren@novostore.com> contributed the doc + in HTML form. Really need to automate this now, sigh. + + Jan.Vlcek@sasprg.cz observed that converting %XX to \u00XX + and then using subst is only good for us-ascii and corrupts + iso8859-1, iso8859-2, etc. He provided a patch for + cgi_unquote_input. + + Ross Mohn <rpmohn@waxandwane.com> corrected syntax error in + cgi_span and made <hr> handle width= better. + + Tore Morkemo provided a patch to his prior patch for cgi_eval. + + Asari Hirotsugu <asari@math.uiuc.edu> provided additional + installation advice for Mac. + +12/27/99 1.2.1 Tore Morkemo noted expires=never value of 9999 inappropriate + as Netscape ignores anything beyond mid-January 2038. + + Tore also provided patch for cgi_eval when running inside of + a proc. + +12/20/99 1.2.0 Keith Lea <keith@cs.oswego.edu> noted 2-digit years as per + RFC2109. Despite RFC, Netscape now accepts 4-digit years. + Some browsers won't like this but it hardly matters anyway + since they'll do the wrong thing on old 2-digit years come + Y2K anyway. + + Petrus Vloet noted example/nistguest missing from distrib. + +12/18/99 1.1.0 Tomas Soucek" <tomas.soucek@sasprg.cz> noted cgi_input was + adding eol characters to uploaded files if they didn't + contain them. Fixed this and also enhanced file upload + example so that it could do both cat/od and also warn when + Tcl couldn't do binary upload. + + Added braces around unprotected expressions. + + Added check to unimail example for HTTP_REFERER. + + Petrus Vloet requested Makefile install example data files. + + Added img.cgi example and modified frame example so it accepts + "example=whatever" so that I can post URLs that go right to a + particular example and have it framed. + +9/12/99 1.0.0 Bumped version to 1 to pacify management. + + Jeffrey Hobbs rewrote cgi_unquote_input to take advantage of + 8.2 features. 300% speed improvement! + +7/16/99 0.8.1 Douglas Ridgway provided mod to make cgi_image_button handle + optional args. + + Made code use straight cgi_input_multipart if on Tcl 8.1. + + Jeffrey Hobbs provided cgi_unquote_input that works better for + 8.1. + + Petrus Vloet <petrus.vloet@siemens.at> requested sample data + files for examples that need them; ability to change example + install destination. + +2/22/98 0.8.0 Tore Morkemo noted that cookied_encode needed to convert \n's. + + Added example of how to produce a raw image. + + Upon suggestion of Jean-Yves Terrien + <jeanyves.terrien@cnet.francetelecom.fr> experimented with + version of cgi_puts that would indent HTML for readability. + Code looked something like this: + + proc NEW_cgi_puts {args} { + global _cgi + + if {$_cgi(preformatted)} { + eval puts $args + } else { + set indent_full [format "%-$_cgi(indent)s" ""] + + # if we're at the beginning of the line, use a full indent + if {$_cgi(bol)} { + set indent $indent_full + } else { + set indent "" + } + + set tail [lindex $args end] + set output "" + + # loop through output, breaking into \n-delimited lines + while {[string length $tail]} { + # this regexp will always match + regexp "^(\[^\n]*)(\n?)(.*)" $tail dummy line nl tail + append output $indent$line + if {$nl == ""} { + set _cgi(bol) 0 + break + } + append output \n + set $_cgi(bol) 1 + set indent $indent_full + } + + # handle optional -nonewline + if {[llength $args] == 1} { + append output \n + set _cgi(bol) 1 + } + puts -nonewline $output + } + } + + Unfortunately, some tags are whitespace-sensitive such as + textarea. If you do cgi_buffer {p;textarea ...} how can cgi_ + puts possibly know that part of the buffer shouldn't be + modified? A user-level flag could be added to avoid corrupting + the HTML but the source display could never be made perfect. + Considering that programmers would have to be aware of these + issues (via flags or options) and the payoff is so minute, it's + just not worth it. I think. As an aside, does regexp on every + line of output cost too much? I doubt anyone would notice but + it's something to ponder. + + Renamed internal cgi routines with _ prefix. + + Matthew Levine <mlevine@cisco.com> observed that cgi_eval + did a #0 eval but a plain eval is more appropriate. + + Anthony Martin <anthony.n.martin@marconicomms.com> noted that + cgi_cgi_set needs to rewrite #. + + Removed cgi_http_get. + + Added registry support to uid_check. + + Eddy Kim <ehkim@ibm.net> noted bug in doc regarding cgi_puts. + + cgi_file_button now verifies that form has correct encoding. + + Fixed doc to reflect more precise use of selected_if_equal. + + Ralph Billes <echo@iinet.net.au> fixed bug in cgi_uid_check. + + Began adding stylesheet support. Made cgi_stylesheet and + cgi_span. Not yet documented. + + Douglas Ridgway <ridgway@gmcl.com> noted that lynx doesn't + respond correctly to multipart form requests. Added check and + diagnostic. Doug also found a bug in the multipart_binary + because I forgot to turn off the timeout. + + Stefan Hornburg <racke@gundel.han.de> writes: + "I've made a RPM package for cgi.tcl. Available at: + http://www.han.de/~racke/linuxia/noarch/cgi.tcl-0.7.5-1.noarch.rpm + http://www.han.de/~racke/linuxia/srpms/cgi.tcl-0.7.5-1.src.rpm + http://www.han.de/~racke/linuxia/specs/cgitcl.spec + and hopefully soon at Redhat/Contrib." + He also noted a missing example: download.cgi. + +6/25/98 0.7.5 Henk-Jan Kooiman <hjk@cable.a2000.nl> fixed bugs in + cgi_relationship and also provided MacOS instructions. + + Martin Schwenke <Martin.Schwenke@cs.anu.edu.au> and Ryan + McCormack <ryanm@cam.nist.gov> both reported textarea lost + newlines when using multipart. + + At urging of Robert Baptista <Robert.Baptista@vanmail.amd.com>, + began adding HTML 4.0 support. Changed cgi_center to avoid + <center>. + + Added download.cgi example. + + John Koontz noted example in file upload documentation still + used deprecated flags. + + 0.7.4 Fixed bug in cgi_refresh. + + Added alt attr to cgi_area. + + Added vote.cgi example. + + Localized some init-time vars to avoid stomping on user's. + + Made cgi_quote_url also quote {"} so URLs. This isn't strictly + necessary, but since URLs will usually be embedded inside HTML, + this simplifies embedding and doesn't hurt anything else. + + Tom Poindexter <tpoindex@nyx.net> added cgi_suffix. + + Removed reference to sendmail from documentation since sendmail + is no longer required. + +12/16/97 0.7.3 Provided SMTP dialogue to replace call to sendmail and removed + all other UNIXisms (exec and direct refs to file system). + + Rewrote LUHN proc in credit card example to work correctly! + + Added type tag support to cgi_relationship. + +11/10/97 0.7.2 Massaged documentation to describe installation on W95/NT.... + Made example.tcl and date.cgi portable. + + Added rm.cgi example. + + Beat Jucker <bj@glue.ch> fixed syntax error in oratcl.cgi + example. + +10/20/97 0.7.1 Fixed cgi_option so that value strings are quoted. Also made + selected_if_equal check value rather than visible string. + + Tore Morkemo <tore@bibsyst.no> provided patch so that cgi_set + translated "=". + + Fixed buffering bug in push example. + + Added credit card example. + + Paul Saxe <saxe@connectnet.com> noted cgi_embed broke due to + unprotected regexp pattern beginning with -. + + +8/22/97 0.7.0 INCOMPATIBILITY: cgi_anchor_name now returns the anchor tag + instead of printing it. Only after some experience do I see + now that anchors always need to be embedded in something else + for accuracy in the jump. + + Josh Lubell noted that file upload failed if there was + whitespace in filename. Problem was that filename-encoding + doesn't encode whitespace or otherwise protect it. There is + no perfect fix since the spec doesn't explain how to know when + fields end. The implication is that they are delimited by + " however an embedded " is not encoded either! For now, assume + filename field is at end of line. This isn't the greatest idea + for it allows future encoding changes to break the code, but + for now it will pick up all filenames including really weird + ones like 'a b"; foo="bar' that would otherwise appear to be + additional fields! + + Jon Leech <leech@cs.unc.edu> provided code to allow user to + temporarily use existing links but displaying differently. + + Alvaro Santamaria <alvaro.santamaria@stest.ch> noted that I + forgot to include kill.cgi and oratcl.cgi in example directory. + + John Koontz noted cgi_buffer's defn of cgi_puts assumed "usual" + newline generation - interacted badly inside of <pre> tags. + Added cgi_buffer_nl to control this. + + James Ward requested option to change ".cgi" suffix. Added + -suffix to cgi_cgi. + + Someone's browser (Mozilla/4.01 [en] (WinNT; I) via proxy + gateway CERN-HTTPD/3.0 libwww/2.17) supplied a boundary defn + but no actual boundary. Added test to + cgi_input_multipart_binary. + + James Ward found cgi_import_list didn't return List vars. + + Diagnostics about broken multipart responses are now returned + to users (who are using old browsers). + + Changed nbsp to numeric equiv to support NS2. + + Made cgi_debug always return old value. + +6/4/97 0.6.6 Added cgi_buffer - force commands that normally generate output + to return strings. + + Deprecated -local & -remote flags to import_filename. Added + support for -server & -client which are less confusing. + + Improved examples in numerous ways. + + James Ward <jew@mcmuse.mc.maricopa.edu> noted I forgot to + document cgi_img. + + Upgraded cgi_quote as per HTML 3.2 + + Mark Diekhans <markd@Grizzly.COM> provided bug fix to cgi_tr + and optional level arg to all uplevel/upvar calls to avoid + misinterpretation. Also added cgi_th. + + Appears that NS3.0 has a bug wrt multipart. It won't display + last fragment on page unless followed by a <br> (even if it + sees </body>). Added cgi_br to multipart support code. + +5/26/97 0.6.5 Added server-push example which required mods to cgi_title + (bug fix actually), cgi_head, and related code to detect and + handle multipart mime type. + + Added HTTP_HOST to list of things reported_HOST during errors. + + Looks like MS IE can generate cookies without an "=val" part. + + Added Oratcl example. + + Documented cgi_url. + + Fixed search for Tcl executable when look in Tcl's srcdir. + + Added support for detection/reporting of client errors. For + now this means missing CONTENT_LENGTH. + + Created cgi_redirect and deprecated cgi_location. cgi_redirect + is better named and more functional. Added cgi_status. + + Modified unimail example so that it shows diagnostics about + form problems to client - doesn't make sense to send them to + unimail admin. + + Improved form-tour in various ways including making a backend + that actually reports value. + + Fixed bug in textvar that caused args to be generated twice. + +4/8/97 0.6.4 John LoVerso fixed regsub quote bug in cgi_quote_url. Fixed + similar bug cgi_cgi_set. + + Most general path cookies were being returned. Changed to most + specific and added -all to cookie_get so that all values could + be retrieved. Added cookie support to passwd example since + that's a very reasonable use of it. + +4/7/97 0.6.3 John LoVerso fixed bugs in cgi_meta and cgi_map. + + INCOMPATIBILITY: cgi_quote_url was inappropriate for non-cgi + urls. cgi_cgi and cgi_cgi_set should now be used for building + GET-style cgi urls. + + Forgot to switch to cgi.tcl.in in distribution. + +3/28/97 0.6.2 Made cgi.tcl.in autohandle embedded version number (see 0.6.1). + + Fixed display.cgi to prevent display of "." or ".." or "". + + Added cgi.tcl version to diagnostics. + Fixed diagnostics to correctly print input. (Totally missing!) + + John Koontz noted extra \r\n at end of uploaded text files. + +3/24/97 0.6.1 Updated package provide version. (Gotta automate this!) + +3/20/97 0.6.0 Added kill.cgi example to kill/suspend runaway CGI processes. + + Modified passwd.cgi example to quote shell arg. + + Kevin.Christian requested hook for defining doctypes. + + John Robert LoVerso <john@loverso.southborough.ma.us> provided + fixes to allow array-style variables names to be rewritten by + cgi_input. Parens had been left with embedded %s substituted. + My research indicates cookies have similar problems but file- + style encoding does not. + + Josh Lubell found bug in binary upload that would drop \r\n + and \r*. + +2/28/97 0.5.5 Combined many regexps that had parameterizably-common actions. + The old regexps had some bugs in them, so it's a good thing. + + M. Katherine Pagoaga <pagoaga@boulder.nist.gov> and John + Koontz <koontz@boulder.nist.gov> noted cgi_uid_check used + whoami which isn't very portable. Switched to "who am i". + Its output isn't very portable but at least its existence is! + + Removed default call to cgi_uid_check. It's my impression that + most people turn this off anyway. If you want it back, just + call it yourself. + + Added cgi_import_filename to guarantee that a filename really + did come from an upload. This removes the security check that + the user was responsible for - and which I forgot in the + upload examples! + + Rolf Ade <rolf@storz.de> noted that configure could look for + tcl executable in a few more locations. + +2/26/97 0.5.4 Backed out type=text from 0.4.4. This ruined type=password. + If people demand, I'll make the code put in type=text but I now + regret the detour. + + Made cgi_import_list return variables in order originally + appearing in form. + +2/24/97 0.5.3 Added tr/td as shortcut for simple table rows. + + Made cookie code look in COOKIE (O'Reilly's web server uses + that instead of HTTP_COOKIE). + + Kevin.Christian@symbio.com requested warning when form + incorrectly uses select without "List" suffix. Also provided + more obvious diagnostics when applying cgi_import* to non- + existent variable. At same time, I also noticed bug in + cgi_import_cookie* preventing it from seeing user variables. + + Forgot to have cgi_root return root with no args. + +2/11/97 0.5.2 Josh Lubell found binary upload broke, due to one send missing + "--" protection. + + Massaged home page so that it works more intelligently with + frames. Massaged examples for both function and appearance. + +2/10/97 0.5.1 Fixed display of validate example. + + Added cgi_unbreakable_string so that it returns a string. + Compare with cgi_unbreakable. + + Added cgi_javascript and noscript. javascript is like script + but does the javascript-compatible hiding of <script> tags for + older browsers. Added some javascript examples. Added support + for java event types. Netscape documentation is very unclear + as to which tags support which attributions - so I guessed a + lot! + +2/4/97 0.5.0 Added cgi_body_args to make it easier to share and change body + attributes. + + Fixed bug in cookie encoder that caused double %-expansion. + + INCOMPATIBILITY: Modified cgi_preformatted to evaluate last + argument. More flexible this way. Since <pre> forces line + breaks, it's not like inline formatting commands. + Removed cgi_code since it used the xmp tag which is gone. + See documentation for workaround. + + INCOMPATIBILITY: Changed cgi_division to take a command list + rather than a string. + + Added cgi_nl for inline breaks. (Compare with cgi_br.) + +2/3/97 0.4.9 Added support for package loading, now you just say: + "package require cgi" + + Added/modified examples so that they could be put up on + web servers. + + Added support to suppress binary upload when using Expect. + +1/31/97 0.4.8 Andreas Kupries <a.kupries@westend.com> needed dynamic control + of ouput. Added user-defineable cgi_puts. + + Josh Lubell <lubell@cme.nist.gov> reported binary file upload + was losing chars on large files. Fixed. + + Fixed cgi_input to understand REQUEST_METHOD == HEAD should + set input to "". + +1/13/97 0.4.7 Braces in password script was wrong. + + Simplified command aliasing mechanism. + + Add some more bulletproofing to catch broken boundary defns... + + Evidentally QUERY_STRING doesn't have to be set even with GET. + CGI spec is vague enough to permit this. + +12/16/96 0.4.6 Giorgetti Federico <gio@egeo.unipg.it> noted text file upload + wasn't working - forgot "_binary" on new upload proc name. + +12/10/96 0.4.5 Added support for binary file upload if using Expect extension. + + Removed check for missing filenames in file upload. This + can evidentally happen. It is now the programmer's + reptysponsibility to check for the length if null filenames are + unwanted. + + Created HTML home page for cgi.tcl. + +11/26/96 0.4.4 Added type=text for pedantic html checkers. + Bob Lipman noted new if_equal handlers used name instead of + value. + +10/24/96 0.4.3 Forgot global _cgi decls in cgi_refresh and some other procs. + + Bob Lipman noted cgi_radio_button needs checked_if_equal. + Added that and same to cgi_checkbox. + +10/15/96 0.4.2 Remove line-delimiters in non-file elements in multipart enc. + + Added support for additional args to cgi_file_button. + +9/19/96 0.4.1 Bob Lipman noted cookie containing = could not be imported. + + Fixed examples to reference .4 source. + +9/9/96 0.4.0 Added cgi_error_occurred. + In multipart handler, added test for "--" because some + servers(?) don't provide explicit eof, but just hang. + Bugs in close_procs support. + Added auto-htmlquoting to cgi_option. + Removed auto-quoting in cgi_cgi. + Made cgi_root also return root if no arg. + Messed up quoting in cgi_anchor_name and cgi_applet. + cgi_parray was missing <xmp> tag. How odd. + +8/12/96 0.3.5 Mark Pahlavan <mark@vestek.com> provided new cgi_caption defn + after noting that it must allow executable code. + + File upload broke in Tcl 7.5 due to auto-eol translation + +6/19/96 0.3.4 Mark Harrison <mharriso@spdmail.spd.dsccc.com> noted ref to + obsolete cgi_uid_ignore. + +6/19/96 0.3.3 Was wrongly cookie-encoding cookie expiration. cgi_imglink + was confused. Thanks again, Bob. + +6/17/96 0.3.2 Reports from Bob Lipman <lipman@cam.nist.gov> about bad + tables and missing </head>. Fixed. + +6/13/96 0.3.1 Added ";" to &-escapes. Fixed bugs in cgi_unquote_input. + Added cgi_embed. Added doc directory with ref manual. + diff --git a/web/src/cgi.tcl-1.10/INSTALL b/web/src/cgi.tcl-1.10/INSTALL new file mode 100644 index 00000000..4a7f8a76 --- /dev/null +++ b/web/src/cgi.tcl-1.10/INSTALL @@ -0,0 +1,96 @@ +This file is INSTALL. It contains installation instructions for cgi.tcl. + +If you do not have Tcl, get it (the README explains how) and install +it. The rest of these instructions assume that you have Tcl +installed. + +-------------------- +Installation +-------------------- + +By default, the Tcl source directory is assumed to be in the same +directory as the cgi.tcl source directory. For example, in this +listing, cgi.tcl and Tcl are both stored in /usr/local/src: + + /usr/local/src/tcl7.5 (actual version may be different) + /usr/local/src/cgi.tcl-1.0 (actual version may be different) + +If Tcl is stored elsewhere, the easiest way to deal with this is to +create a symbolic link to its real directory. For example, from the +cgi.tcl directory, type: + + ln -s /some/where/else/src/tcl7.5 .. + +Run "./configure". This will generate a Makefile (from a prototype +called "Makefile.in") appropriate to your system. Make sure you run +configure with the same arguments as when you ran Tcl's configure +script. (If you don't, package loading won't work.) + +Most people will not need to make any changes to the generated +Makefile and can go on to the next step. If you want though, you can +edit the Makefile and change any definitions as appropriate for your +site. All the definitions you are likely to want to change are +clearly identified and described at the beginning of the file. + +Run "make". + +It is useful (although not necessary) for cgi.tcl to understand how to +send mail. By default, cgi.tcl tries to use /usr/lib/sendmail, +otherwise it falls back to carrying out the raw SMTP dialogue itself. +Any mailer can be substituted by modifying cgi.tcl appropriately. It +is easy to do. Edit cgi.tcl and look at the cgi_mail_end procedure. +It should be obvious what to do at that point. The ability to send +mail isn't required for basic use of cgi.tcl, but it is especially +useful for in-the-field debugging so I encourage you to enable it. + +You can now "source cgi.tcl" if you want to try things out by hand +before installing (or if you want to use the package without +installing it). Example: + + $ tclsh7.6 (or whatever your Tcl interpreter is called) + % source cgi.tcl + % h4 "Don Libes" + <h4>Don Libes</h4> + % + +Once you're done playing, go ahead and install it. To install everything: + + make install + +You're done! Now you can use cgi.tcl. + +-------------------- +Examples +-------------------- + +The example directory has some examples. See the README in there. + +-------------------- +Test Suite +-------------------- + +There is no test suite. + +-------------------- +Uninstalling +-------------------- + +"make uninstall" removes all the files that "make install" creates +(excluding those in the current directory). + +-------------------- +Cleaning Up +-------------------- + +Several "clean" targets are available to reduce space consumption of +the cgi.tcl source. The two most useful are as follows: + +"make clean" deletes all files from the current directory that were +created by "make" + +"make distclean" is like "make clean", but it also deletes files +created by "configure" + +Other targets can be found in the Makefile. They follow the GNU +Makefile conventions. + diff --git a/web/src/cgi.tcl-1.10/Makefile.in b/web/src/cgi.tcl-1.10/Makefile.in new file mode 100644 index 00000000..3f818f2c --- /dev/null +++ b/web/src/cgi.tcl-1.10/Makefile.in @@ -0,0 +1,273 @@ +# +# Makefile for Don Libes' cgi.tcl - routines for writing CGI scripts in Tcl +# + +VERSION = \"@CGI_VERSION_FULL@\" +SHORT_VERSION = @CGI_VERSION@ + +srcdir = @srcdir@ +VPATH = @srcdir@ +SUBDIRS = @subdirs@ + +###################################################################### +# The following lines are things you may want to change +###################################################################### + +# By default, "make install" will install the appropriate files in +# /usr/local/bin, /usr/local/lib, /usr/local/man, etc. By changing this +# variable, you can specify an installation prefix other than /usr/local. +# You may find it preferable to call configure with the --prefix option +# to control this information. This is especially handy if you are +# installing this several times (perhaps on a number of machines or +# in different places). Then you don't have to hand-edit this file. +# See the INSTALL file for more information. (Analogous information +# applies to the next variable as well.) +prefix = @prefix@ + +# You can specify a separate installation prefix for architecture-specific +# files such as binaries and libraries. +exec_prefix = @exec_prefix@ + +# Short directory path where binaries can be found to support #! hack. +# This directory path can be the same as the directory in which the binary +# actually sits except when the path is so long that the #! mechanism breaks +# (usually at 32 characters). +# The solution is to create a directory with a very short name, which consists +# only of symbolic links back to the true binaries. Subtracting two for "#!" +# and a couple more for arguments (typically " -f" or " --") gives you 27 +# characters. Pathnames over this length won't be able to use the #! magic. +# For more info on this, see the execve(2) man page. +SHORT_BINDIR = $(exec_prefix)/bin + +# Tcl interpreter for utility work. +CGI_TCL_EXECUTABLE = @CGI_TCL_EXECUTABLE@ + +# Where to put the examples - a directory in which your web server has +# permission to execute CGI scripts. +exampledir = /tmp/cgi-bin/cgi-tcl-examples + +###################################################################### +# End of things you may want to change +# +# Do not change anything after this +###################################################################### + +bindir_arch_indep = $(prefix)/bin +libdir = $(exec_prefix)/lib +datadir = $(prefix)/lib + +mandir = $(prefix)/man +man1dir = $(mandir)/man1 +man3dir = $(mandir)/man3 +docdir = $(datadir)/doc + +# utility script directories - arch-independent and arch-non- +# independent. +SCRIPTDIR = $(datadir)/cgi$(SHORT_VERSION) +EXECSCRIPTDIR = $(execdatadir)/cgi$(SHORT_VERSION) + +INSTALL = @INSTALL@ +INSTALL_PROGRAM = @INSTALL_PROGRAM@ +INSTALL_DATA = @INSTALL_DATA@ + +# To install the following examples: make examples +EXAMPLES=cookie.cgi creditcard.cgi \ + display.cgi display-in-frame.cgi download.cgi \ + echo.cgi error.cgi evaljs.cgi example.tcl examples.cgi \ + form-tour.cgi form-tour-result.cgi format-tour.cgi frame.cgi \ + image.cgi img.cgi kill.cgi nistguest.cgi oratcl.cgi \ + parray.cgi passwd.tcl passwd-form.cgi passwd.cgi \ + push.cgi rm.cgi stopwatch.cgi \ + unimail.cgi upload.cgi uploadbin.cgi \ + validate.cgi vclock.cgi vclock.pl vclock-src-frame.cgi visitor.cgi \ + vote.cgi + +EXAMPLES_DATA=nistguest vote.cnt + +all: cgi.tcl pkgIndex.tcl + +info: +dvi: + +# Delete all the installed files that the `install' target creates +# (but not the noninstalled files such as `make all' creates) +uninstall: + -rm -f $(SCRIPTDIR)/cgi.tcl + -rm -f $(man3dir)/cgi.tcl.3 + -rm -f $(SCRIPTDIR)/pkgIndex.tcl + +.PHONY: install-info install info +install-info: + +install: all + ${srcdir}/mkinstalldirs $(man3dir) $(SCRIPTDIR) $(exampledir) $(exampledir)/data +# install scripts + $(INSTALL_DATA) cgi.tcl $(SCRIPTDIR) +# install library man page + $(INSTALL_DATA) cgi.tcl.man $(man3dir)/cgi.tcl.3 + $(INSTALL_DATA) pkgIndex.tcl $(SCRIPTDIR) + +examples: + for i in $(EXAMPLES) ; do \ + $(CGI_TCL_EXECUTABLE) $(srcdir)/fixline1 $(SHORT_BINDIR) < $(srcdir)/example/$$i > $$i ; \ + $(INSTALL_PROGRAM) $$i $(exampledir) ; \ + rm -f $$i ; \ + done + for i in $(EXAMPLES_DATA) ; do \ + $(INSTALL) -m 666 $(srcdir)/example/$$i $(exampledir)/data ; \ + done + +cgi.tcl: $(srcdir)/cgi.tcl.in + @echo "Rebuilding cgi.tcl..." + $(SHELL) ./config.status + +################################### +# Targets for Makefile and configure +################################### + +Makefile: $(srcdir)/Makefile.in $(host_makefile_frag) config.status + @echo "Rebuilding the Makefile..." + $(SHELL) ./config.status + +# Let "make -f Makefile.in" produce a configure file +configure: $(srcdir)/configure.in $(srcdir)/Makefile.in + @echo "Rebuilding configure..." + if [ x"${srcdir}" = x"@srcdir@" ] ; then \ + srcdir=. ; export srcdir ; \ + else true ; fi ; \ + (cd $${srcdir}; autoconf) + +config.status: $(srcdir)/configure + @echo "Rebuilding config.status..." + $(SHELL) ./config.status --recheck + +check: + @if [ -f testsuite/Makefile ]; then \ + cd testsuite && $(MAKE) $(FLAGS_TO_PASS) check; \ + else true; fi + +# updating of pkgIndex.tcl has not yet been totally automated +# Instructions: +# 1) Replace version # in cgi.tcl with updated version. +# (Gad, I'd have to turn the whole source into .in file to automate this +# and it'd be a major nuisance when developing!) +pkgIndex.tcl: cgi.tcl + $(CGI_TCL_EXECUTABLE) pkgcreate + +################################################ +# Various "clean" targets follow GNU conventions +################################################ + +# delete all files from current directory that are created by "make" +clean: + -rm -f *~ *.o core + +# like "clean", but also delete files created by "configure" +distclean: clean + -rm -f Makefile config.status config.cache config.log + -rm -f Dbg_cf.h + +# like "clean", but doesn't delete test utilities or massaged scripts +# because most people don't have to worry about them +mostlyclean: + -rm -f *~ *.o core + +# delete everything from current directory that can be reconstructed +# except for configure +realclean: distclean + +###################################### +# Targets for pushing out releases +###################################### + +FTPDIR = /itl/www/div826/subject/expect/cgi.tcl + +# make a private tar file for myself +tar: cgi.tcl-$(SHORT_VERSION).tar + mv cgi.tcl-$(SHORT_VERSION).tar cgi.tcl.tar + +# Make a release and install it on ftp server +# Note that we run configure on our end to make sure that cgi.tcl is usable +# for people who don't have configure at the destination end (non-UNIX folks). +ftp: cgi.tcl cgi.tcl-$(SHORT_VERSION).tar.Z cgi.tcl-$(SHORT_VERSION).tar.gz install-html + cp cgi.tcl-$(SHORT_VERSION).tar.Z $(FTPDIR)/cgi.tcl.tar.Z + cp cgi.tcl-$(SHORT_VERSION).tar.gz $(FTPDIR)/cgi.tcl.tar.gz + cp HISTORY $(FTPDIR) + cp README $(FTPDIR)/README.distribution + cp doc/ref.txt $(FTPDIR) + cp doc/ref.html $(FTPDIR) + cp example/README $(FTPDIR)/example + cp `pubfile example` $(FTPDIR)/example + ls -l $(FTPDIR)/cgi.tcl.tar* +# delete temp files + rm cgi.tcl-$(SHORT_VERSION).tar* + +cgi.tcl-$(SHORT_VERSION).tar: configure + rm -f ../cgi.tcl-$(SHORT_VERSION) + ln -s `pwd` ../cgi.tcl-$(SHORT_VERSION) + cd ..;tar cvfh $@ `pubfile cgi.tcl-$(SHORT_VERSION)` + mv ../$@ . + +cgi.tcl-$(SHORT_VERSION).tar.Z: cgi.tcl-$(SHORT_VERSION).tar + compress -fc cgi.tcl-$(SHORT_VERSION).tar > $@ + +cgi.tcl-$(SHORT_VERSION).tar.gz: cgi.tcl-$(SHORT_VERSION).tar + gzip -fc cgi.tcl-$(SHORT_VERSION).tar > $@ + +########################### +# Targets for producing FAQ and homepage +########################### + +NISTCGI_PREFIX = /local +NISTCGI_HOST = ats.nist.gov +NISTCGI_INTERPDIR = $(NISTCGI_PREFIX)/bin +NISTCGI_LIBDIR = $(NISTCGI_PREFIX)/lib/cgi$(SHORT_VERSION) +NISTCGI_EXAMPLEDIR = $(NISTCGI_HOST):/private/home/http/cgi-bin/cgi.tcl +NISTCGI_HTMLDIR = /itl/www/div826/subject/expect/cgi.tcl + +# create the FAQ in html form +FAQ.html: FAQ.src FAQ.tcl + FAQ.src > FAQ.html + +# create the FAQ in text form +#FAQ: FAQ.src FAQ.tcl +# FAQ.src text > FAQ + +# generate home page +homepage.html: homepage.src common.tcl configure + homepage.src > homepage.html + +realapps.html: realapps.src common.tcl + realapps.src > realapps.html + +RSH = ssh +RCP = scp + +# install various html docs on our web server +install-html: FAQ.html homepage.html realapps.html pkgIndex.tcl cgi.tcl + cp FAQ.html $(NISTCGI_HTMLDIR)/ + cp homepage.html $(NISTCGI_HTMLDIR)/index.html + cp realapps.html $(NISTCGI_HTMLDIR)/ + -$(RSH) $(NISTCGI_HOST) mkdir $(NISTCGI_LIBDIR)/ + $(RCP) cgi.tcl pkgIndex.tcl $(NISTCGI_HOST):$(NISTCGI_LIBDIR)/ + for i in $(EXAMPLES) ; do \ + $(CGI_TCL_EXECUTABLE) $(srcdir)/fixline1 $(NISTCGI_INTERPDIR) < $(srcdir)/example/$$i > $$i ; \ + $(RCP) $$i $(NISTCGI_EXAMPLEDIR)/ ; \ + rm -f $$i ; \ + done + +# add recursive support to the build process. +subdir_do: force + @for i in $(SUBDIRS); do \ + echo "Making $(DO) in $${i}..." ; \ + if [ -d ./$$i ] ; then \ + if (rootme=`pwd`/ ; export rootme ; \ + rootsrc=`cd $(srcdir); pwd`/ ; export rootsrc ; \ + cd ./$$i; \ + $(MAKE) $(FLAGS_TO_PASS) $(DO)) ; then true ; \ + else exit 1 ; fi ; \ + else true ; fi ; \ + done +force: + +## dependencies will be put after this line... ## diff --git a/web/src/cgi.tcl-1.10/PATCH.UW b/web/src/cgi.tcl-1.10/PATCH.UW new file mode 100644 index 00000000..0288cb72 --- /dev/null +++ b/web/src/cgi.tcl-1.10/PATCH.UW @@ -0,0 +1,230 @@ +*** ./cgi.tcl.in.orig 2006-05-01 11:15:52.000000000 -0700 +--- ./cgi.tcl.in 2006-11-14 16:01:51.000000000 -0800 +*************** +*** 52,58 **** + + if {[info exists _cgi(http_status_done)]} return + set _cgi(http_status_done) 1 +! puts "Status: $num $str" + } + + # If these are called manually, they automatically generate the extra newline +--- 52,58 ---- + + if {[info exists _cgi(http_status_done)]} return + set _cgi(http_status_done) 1 +! cgi_puts "Status: $num $str" + } + + # If these are called manually, they automatically generate the extra newline +*************** +*** 1342,1348 **** + set dbg_filename [file join $_cgi(tmpdir) CGIdbg.[pid]] + # explicitly flush all writes to fout, because sometimes the writer + # can hang and we won't get to the termination code +! set dbg_fout [open $dbg_filename w] + set _cgi(input) $dbg_filename + catch {fconfigure $dbg_fout -translation binary} + } +--- 1342,1348 ---- + set dbg_filename [file join $_cgi(tmpdir) CGIdbg.[pid]] + # explicitly flush all writes to fout, because sometimes the writer + # can hang and we won't get to the termination code +! set dbg_fout [open $dbg_filename w $_cgi(tmpperms)] + set _cgi(input) $dbg_filename + catch {fconfigure $dbg_fout -translation binary} + } +*************** +*** 1409,1415 **** + + # read the part into a file + set foutname [file join $_cgi(tmpdir) CGI[pid].[incr _cgi(file,filecount)]] +! set fout [open $foutname w] + # "catch" permits this to work with Tcl 7.4 + catch {fconfigure $fout -translation binary} + _cgi_set_uservar $varname [list $foutname $filename $conttype] +--- 1409,1415 ---- + + # read the part into a file + set foutname [file join $_cgi(tmpdir) CGI[pid].[incr _cgi(file,filecount)]] +! set fout [open $foutname w $_cgi(tmpperms)] + # "catch" permits this to work with Tcl 7.4 + catch {fconfigure $fout -translation binary} + _cgi_set_uservar $varname [list $foutname $filename $conttype] +*************** +*** 1452,1457 **** +--- 1452,1458 ---- + } else { + # read the part into a variable + set val "" ++ set blanks 0 + while {1} { + if {-1 == [gets $fin buf]} break + if {[info exists dbg_fout]} {puts $dbg_fout $buf; flush $dbg_fout} +*************** +*** 1463,1468 **** +--- 1464,1479 ---- + append val \n + } + regexp (.*)\r$ $buf dummy buf ++ if {[info exists blanks]} { ++ if {0!=[string compare $buf ""]} { ++ if {$blanks} { ++ append val [string repeat \n [incr blanks]] ++ } ++ unset blanks ++ } else { ++ incr blanks ++ } ++ } + append val $buf + } + _cgi_set_uservar $varname $val +*************** +*** 1482,1488 **** + # save file for debugging purposes + set dbg_filename [file join $_cgi(tmpdir) CGIdbg.[pid]] + set _cgi(input) $dbg_filename +! spawn -open [open $dbg_filename w] + set dbg_sid $spawn_id + } + spawn -open $fin +--- 1493,1499 ---- + # save file for debugging purposes + set dbg_filename [file join $_cgi(tmpdir) CGIdbg.[pid]] + set _cgi(input) $dbg_filename +! spawn -open [open $dbg_filename w $_cgi(tmpperms)] + set dbg_sid $spawn_id + } + spawn -open $fin +*************** +*** 1579,1585 **** + + # read the part into a file + set foutname [file join $_cgi(tmpdir) CGI[pid].[incr _cgi(file,filecount)]] +! spawn -open [open $foutname w] + set fout_sid $spawn_id + + _cgi_set_uservar $varname [list $foutname $filename $conttype] +--- 1590,1596 ---- + + # read the part into a file + set foutname [file join $_cgi(tmpdir) CGI[pid].[incr _cgi(file,filecount)]] +! spawn -open [open $foutname w $_cgi(tmpperms)] + set fout_sid $spawn_id + + _cgi_set_uservar $varname [list $foutname $filename $conttype] +*************** +*** 2187,2202 **** + + flush $_cgi(mailfid) + +! if {[file executable /usr/lib/sendmail]} { +! exec /usr/lib/sendmail -t -odb < $_cgi(mailfile) +! # Explanation: +! # -t means: pick up recipient from body +! # -odb means: deliver in background +! # note: bogus local address cause sendmail to fail immediately +! } elseif {[file executable /usr/sbin/sendmail]} { +! exec /usr/sbin/sendmail -t -odb < $_cgi(mailfile) +! # sendmail is in /usr/sbin on some BSD4.4-derived systems. +! } else { + # fallback for sites without sendmail + + if {0==[info exists _cgi(mail_relay)]} { +--- 2198,2215 ---- + + flush $_cgi(mailfid) + +! foreach sendmail in $_cgi(sendmail) { +! if {[file executable $sendmail]} { +! exec $sendmail -t -odb < $_cgi(mailfile) +! # Explanation: +! # -t means: pick up recipient from body +! # -odb means: deliver in background +! # note: bogus local address cause sendmail to fail immediately +! set sent 1 +! } +! } +! +! if {0==[info exists sent]} { + # fallback for sites without sendmail + + if {0==[info exists _cgi(mail_relay)]} { +*************** +*** 2241,2246 **** +--- 2254,2265 ---- + set _cgi(mail_relay) $host + } + ++ proc cgi_sendmail {path} { ++ global _cgi ++ ++ set _cgi(sendmail) $path ++ } ++ + ################################################## + # cookie support + ################################################## +*************** +*** 2416,2422 **** + ################################################## + + proc cgi_stylesheet {href} { +! puts "<link rel=stylesheet href=\"$href\" type=\"text/css\"/>" + } + + proc cgi_span {args} { +--- 2435,2441 ---- + ################################################## + + proc cgi_stylesheet {href} { +! cgi_puts "<link rel=stylesheet href=\"$href\" type=\"text/css\"/>" + } + + proc cgi_span {args} { +*************** +*** 2545,2550 **** +--- 2564,2584 ---- + } + + ################################################## ++ # temporary file procedures ++ ################################################## ++ ++ # set appropriate temporary file modes ++ proc cgi_tmpfile_permissions {{mode ""}} { ++ global _cgi ++ ++ if {[string length $mode]} { ++ set _cgi(tmpperms) $mode ++ } ++ ++ return $_cgi(tmpperms) ++ } ++ ++ ################################################## + # user-defined procedures + ################################################## + +*************** +*** 2604,2615 **** +--- 2638,2655 ---- + switch $tcl_platform(platform) { + unix { + set _cgi(tmpdir) /tmp ++ set _cgi(tmpperms) 0644 ++ set _cgi(sendmail) [list /usr/lib/sendmail /usr/sbin/sendmail] + } macintosh { + set _cgi(tmpdir) [pwd] ++ set _cgi(tmpperms) {} ++ set _cgi(sendmail) {} + } default { + set _cgi(tmpdir) [pwd] + catch {set _cgi(tmpdir) $env(TMP)} + catch {set _cgi(tmpdir) $env(TEMP)} ++ set _cgi(tmpperms) {} ++ set _cgi(sendmail) {} + } + } + diff --git a/web/src/cgi.tcl-1.10/README b/web/src/cgi.tcl-1.10/README new file mode 100644 index 00000000..4c7381fe --- /dev/null +++ b/web/src/cgi.tcl-1.10/README @@ -0,0 +1,140 @@ +This is the README to cgi.tcl, a library of Tcl procedures to assist +in writing CGI scripts. Review the HISTORY file for significant changes. + +The cgi.tcl home page is http://expect.nist.gov/cgi.tcl + +-------------------- +Introduction +-------------------- + +This is the README file for cgi.tcl, a set of procedures for writing +CGI scripts in Tcl. The procedures implement the code described in +the paper "Writing CGI scripts in Tcl" which was published in the +Proceedings of the Fourth Tcl Workshop (Tcl '96). + +-------------------- +Getting Started +-------------------- + +First, read the paper "Writing CGI Scripts in Tcl", from Tcl '96. If +you can't find the paper in this archive, it can also be found at: + + http://www.nist.gov/msidlibrary/doc/libes96c.ps + +That paper will give you a lot of good ideas for using Tcl, not only +with CGI but plain everyday HTML as well. + +Next, try some of the examples in the example directory. Please read +the "Instructions" section in example/README first. + +A rough draft of complete documentation of the individual functions +can be found in ref.txt in the doc directory. + +Note that you are expected to understand Tcl. I'm not going to +explain how to write Tcl scripts here. (If you're looking for a Tcl +tutorial, please consider my Expect book which includes a very nice +tutorial on Tcl.) + +Similarly, you are expected to understand HTML. There are plenty of +web tutorials and books on it. Go read one. You don't have to become +an expert on HTML, but it is important to get a feel for it. (The +cgi.tcl package will take care of the details.) If you plan to do +CGI, you should know a couple more basic things. Here's a simple CGI +intro: + + http://hoohoo.ncsa.uiuc.edu/cgi/intro.html + + +-------------------- +Status +-------------------- + +The library is reasonably complete. It supports forms, tables, +cookies, Netscape extensions, file upload, plug-ins, etc, etc. On the +other hand, there are some things missing - such as certain deprecated +things in HTML, things I can't believe anyone would use, things that +are special extensions to a browser I'm not familiar with, etc. + +This library should run on any system (UNIX, Win, or Mac) which +supports Tcl 8.1 or later. + +---------------------- +Examples +---------------------- + +This distribution contains example scripts. They can be found in the +example directory of this distribution. Please read the +"Instructions" section in example/README first. + +-------------------- +Installation +-------------------- + +If you are on UNIX, read the INSTALL file. +If you are on W95/NT, read the install.win file. +If you are on Mac, read the install.mac file. + +-------------------- +How to get the latest version of this code +-------------------- + +The latest version of this code may be received from: + + http://expect.nist.gov/cgi.tcl/cgi.tcl.tar.gz +or ftp://ftp.nist.gov/mel/div826/subject/expect/cgi.tcl/cgi.tcl.tar.gz + +-------------------- +Support from Don Libes or NIST +-------------------- + +Although I can't promise anything in the way of support, I'd be +interested to hear about your experiences using it (good or bad). I'm +also interested in hearing bug reports and suggestions for improvement +even though I can't promise to implement them. + +If you send me a bug, fix, or question, include the version of +cgi.tcl, version of Tcl, and name and version of the OS that you are +using. Before sending mail, it may be helpful to verify that your +problem still exists in the latest version. You can check on the +current release and whether it addresses your problems by retrieving +the latest HISTORY file (see "History" above). + + +Awards, love letters, and bug reports may be sent to: + +Don Libes +National Institute of Standards and Technology +Bldg 220, Rm A-127 +Gaithersburg, MD 20899 +(301) 975-3535 +libes@nist.gov + +I hereby place this software in the public domain. NIST and I would +appreciate credit if this program or parts of it are used. + +Design and implementation of this program was funded primarily by +myself. Funding contributors include the NIST Automated Manufacturing +Research Facility (funded by the Navy Manufacturing Technology +Program), the NIST Scientific and Technical Research Services, the +ARPA Persistent Object Bases project and the Computer-aided +Acquisition and the Logistic Support (CALS) program of the Office of +the Secretary of Defense. + +-------------------- +Support for Don Libes or NIST +-------------------- + +NIST accepts external funding and other resources (hardware, software, +and personnel). This can be a fine way to work more closely with NIST +and encourage particular areas of research. + +Funding can be earmarked for specific purposes or for less-specific +purposes. For example, if you simply like the work I do, you can +contribute directly to my funding which will reduce the amount of time +I have to spend writing proposals and submitting them to other people +for funding on my own. + +I can also participate in the NIST Fellows program allowing me to +spend several months to a year working directly with your company and +potentially even at your location. + diff --git a/web/src/cgi.tcl-1.10/README.UW b/web/src/cgi.tcl-1.10/README.UW new file mode 100644 index 00000000..7dfe161c --- /dev/null +++ b/web/src/cgi.tcl-1.10/README.UW @@ -0,0 +1,23 @@ +This is the README.UW of the cgi.tcl library as included with the Web +Alpine distribution. + +Web Alpine page generation is based heavily on the routines provided +by the cgi.tcl library. It's shown to be a robust and flexible +platform for generating dynamic web-based content. + +This cgi.tcl library as included with the Web Alpine application has +been slightly modified. The small changes, which can be found in +PATCH.UW, amount to a few things: + + 1) A hook to allow for temporary file permission setting + + 2) A hook to allow for resetting (and specifically, unsetting) + the path to sendmail used for error reporting + + 3) A few fixes for misdirected output ("puts" --> "cgi_puts") + + 4) Change to _cgi_input_multipart to preserve leading + newlines + +For comments or questions regarding the Web Alpine application +send comments to <alpine-contact@cac.washington.edu> diff --git a/web/src/cgi.tcl-1.10/cgi.tcl.in b/web/src/cgi.tcl-1.10/cgi.tcl.in new file mode 100644 index 00000000..df426c08 --- /dev/null +++ b/web/src/cgi.tcl-1.10/cgi.tcl.in @@ -0,0 +1,2659 @@ +################################################## +# +# cgi.tcl - routines for writing CGI scripts in Tcl +# Author: Don Libes <libes@nist.gov>, January '95 +# +# These routines implement the code described in the paper +# "Writing CGI scripts in Tcl" which appeared in the Tcl '96 conference. +# Please read the paper before using this code. The paper is: +# http://expect.nist.gov/doc/cgi.pdf +# +################################################## + +################################################## +# http header support +################################################## + +proc cgi_http_head {args} { + global _cgi env errorInfo + + if {[info exists _cgi(http_head_done)]} return + + set _cgi(http_head_in_progress) 1 + + if {0 == [llength $args]} { + cgi_content_type + } else { + if {[catch {uplevel 1 [lindex $args 0]} errMsg]} { + set savedInfo $errorInfo + cgi_content_type + } + } + cgi_puts "" + + unset _cgi(http_head_in_progress) + set _cgi(http_head_done) 1 + + if {[info exists savedInfo]} { + error $errMsg $savedInfo + } +} + +# avoid generating http head if not in CGI environment +# to allow generation of pure HTML files +proc _cgi_http_head_implicit {} { + global env + + if {[info exists env(REQUEST_METHOD)]} cgi_http_head +} + +proc cgi_status {num str} { + global _cgi + + if {[info exists _cgi(http_status_done)]} return + set _cgi(http_status_done) 1 + cgi_puts "Status: $num $str" +} + +# If these are called manually, they automatically generate the extra newline + +proc cgi_content_type {args} { + global _cgi + + if {0==[llength $args]} { + set t text/html + } else { + set t [lindex $args 0] + if {[regexp ^multipart/ $t]} { + set _cgi(multipart) 1 + } + } + + if {[info exists _cgi(http_head_in_progress)]} { + cgi_puts "Content-type: $t" + } else { + cgi_http_head [list cgi_content_type $t] + } +} + +proc cgi_redirect {t} { + global _cgi + + if {[info exists _cgi(http_head_in_progress)]} { + cgi_status 302 Redirected + cgi_puts "Uri: $t" + cgi_puts "Location: $t" + } else { + cgi_http_head { + cgi_redirect $t + } + } +} + +# deprecated, use cgi_redirect +proc cgi_location {t} { + global _cgi + + if {[info exists _cgi(http_head_in_progress)]} { + cgi_puts "Location: $t" + } else { + cgi_http_head "cgi_location $t" + } +} + +proc cgi_target {t} { + global _cgi + + if {![info exists _cgi(http_head_in_progress)]} { + error "cgi_target must be set from within cgi_http_head." + } + cgi_puts "Window-target: $t" +} + +# Make client retrieve url in this many seconds ("client pull"). +# With no 2nd arg, current url is retrieved. +proc cgi_refresh {seconds {url ""}} { + global _cgi + + if {![info exists _cgi(http_head_in_progress)]} { + error "cgi_refresh must be set from within cgi_http_head. Try using cgi_http_equiv instead." + } + cgi_put "Refresh: $seconds" + + if {0!=[string compare $url ""]} { + cgi_put "; $url" + } + cgi_puts "" +} + +# Example: cgi_pragma no-cache +proc cgi_pragma {arg} { + global _cgi + + if {![info exists _cgi(http_head_in_progress)]} { + error "cgi_pragma must be set from within cgi_http_head." + } + cgi_puts "Pragma: $arg" +} + +################################################## +# support for debugging or other crucial things we need immediately +################################################## + +proc cgi_comment {args} {} ;# need this asap + +proc cgi_html_comment {args} { + regsub -all {>} $args {\>} args + cgi_put "<!--[_cgi_list_to_string $args] -->" +} + +set _cgi(debug) -off +proc cgi_debug {args} { + global _cgi + + set old $_cgi(debug) + set arg [lindex $args 0] + if {$arg == "-on"} { + set _cgi(debug) -on + set args [lrange $args 1 end] + } elseif {$arg == "-off"} { + set _cgi(debug) -off + set args [lrange $args 1 end] + } elseif {[regexp "^-t" $arg]} { + set temp 1 + set _cgi(debug) -on + set args [lrange $args 1 end] + } elseif {[regexp "^-noprint$" $arg]} { + set noprint 1 + set args [lrange $args 1 end] + } + + set arg [lindex $args 0] + if {$arg == "--"} { + set args [lrange $args 1 end] + } + + if {[llength $args]} { + if {$_cgi(debug) == "-on"} { + + _cgi_close_tag + # force http head and open html, head, body + catch { + if {[info exists noprint]} { + uplevel 1 [lindex $args 0] + } else { + cgi_html { + cgi_head { + cgi_title "debugging before complete HTML head" + } + # force body open and leave open + _cgi_body_start + uplevel 1 [lindex $args 0] + # bop back out to catch, so we don't close body + error "ignore" + } + } + } + } + } + + if {[info exists temp]} { + set _cgi(debug) $old + } + return $old +} + +proc cgi_uid_check {user} { + global env + + # leave in so old scripts don't blow up + if {[regexp "^-off$" $user]} return + + if {[info exists env(USER)]} { + set whoami $env(USER) + } elseif {0==[catch {exec whoami} whoami]} { + # "who am i" on some Linux hosts returns "" so try whoami first + } elseif {0==[catch {exec who am i} whoami]} { + # skip over "host!" + regexp "(.*!)?(\[^ \t]*)" $whoami dummy dummy whoami + } elseif {0==[catch {package require registry}]} { + set whoami [registry get HKEY_LOCAL_MACHINE\\Network\\Logon username] + } else { + set whoami $user ;# give up and let go + } + if {$whoami != "$user"} { + error "Warning: This CGI script expects to run with uid \"$user\". However, this script is running as \"$whoami\"." + } +} + +# print out elements of an array +# like Tcl's parray, but formatted for browser +proc cgi_parray {a {pattern *}} { + upvar 1 $a array + if {![array exists array]} { + error "\"$a\" isn't an array" + } + + set maxl 0 + foreach name [lsort [array names array $pattern]] { + if {[string length $name] > $maxl} { + set maxl [string length $name] + } + } + cgi_preformatted { + set maxl [expr {$maxl + [string length $a] + 2}] + foreach name [lsort [array names array $pattern]] { + set nameString [format %s(%s) $a $name] + cgi_puts [cgi_quote_html [format "%-*s = %s" $maxl $nameString $array($name)]] + } + } +} + +proc cgi_eval {cmd} { + global env _cgi + + # put cmd somewhere that uplevel can find it + set _cgi(body) $cmd + + uplevel 1 { + global env _cgi errorInfo + + if {1==[catch $_cgi(body) errMsg]} { + # error occurred, handle it + set _cgi(errorInfo) $errorInfo + + if {![info exists env(REQUEST_METHOD)]} { + puts stderr $_cgi(errorInfo) + return + } + # the following code is all to force browsers into a state + # such that diagnostics can be reliably shown + + # close irrelevant things + _cgi_close_procs + # force http head and open html, head, body + cgi_html { + cgi_body { + if {[info exists _cgi(client_error)]} { + cgi_h3 "Client Error" + cgi_p "$errMsg Report this to your system administrator or browser vendor." + } else { + cgi_put [cgi_anchor_name cgierror] + cgi_h3 "An internal error was detected in the service\ + software. The diagnostics are being emailed to\ + the service system administrator ($_cgi(admin_email))." + + if {$_cgi(debug) == "-on"} { + cgi_puts "Heck, since you're debugging, I'll show you the\ + errors right here:" + # suppress formatting + cgi_preformatted { + cgi_puts [cgi_quote_html $_cgi(errorInfo)] + } + } else { + cgi_mail_start $_cgi(admin_email) + cgi_mail_add "Subject: [cgi_name] CGI problem" + cgi_mail_add + cgi_mail_add "CGI environment:" + cgi_mail_add "REQUEST_METHOD: $env(REQUEST_METHOD)" + cgi_mail_add "SCRIPT_NAME: $env(SCRIPT_NAME)" + # this next few things probably don't need + # a catch but I'm not positive + catch {cgi_mail_add "HTTP_USER_AGENT: $env(HTTP_USER_AGENT)"} + catch {cgi_mail_add "HTTP_REFERER: $env(HTTP_REFERER)"} + catch {cgi_mail_add "HTTP_HOST: $env(HTTP_HOST)"} + catch {cgi_mail_add "REMOTE_HOST: $env(REMOTE_HOST)"} + catch {cgi_mail_add "REMOTE_ADDR: $env(REMOTE_ADDR)"} + cgi_mail_add "cgi.tcl version: @CGI_VERSION_FULL@" + cgi_mail_add "input:" + catch {cgi_mail_add $_cgi(input)} + cgi_mail_add "cookie:" + catch {cgi_mail_add $env(HTTP_COOKIE)} + cgi_mail_add "errorInfo:" + cgi_mail_add "$_cgi(errorInfo)" + cgi_mail_end + } + } + } ;# end cgi_body + } ;# end cgi_html + } ;# end catch + } ;# end uplevel +} + +# return true if cgi_eval caught an error +proc cgi_error_occurred {} { + global _cgi + + return [info exists _cgi(errorInfo)] +} + +################################################## +# CGI URL creation +################################################## + +# declare location of root of CGI files +# this allows all CGI references to be relative in the source +# making it easy to move everything in the future +# If you have multiple roots, just don't call this. +proc cgi_root {args} { + global _cgi + + if {[llength $args]} { + set _cgi(root) [lindex $args 0] + } else { + set _cgi(root) + } +} + +# make a URL for a CGI script +proc cgi_cgi {args} { + global _cgi + + set root $_cgi(root) + if {0!=[string compare $root ""]} { + if {![regexp "/$" $root]} { + append root "/" + } + } + + set suffix [cgi_suffix] + + set arg [lindex $args 0] + if {0==[string compare $arg "-suffix"]} { + set suffix [lindex $args 1] + set args [lrange $args 2 end] + } + + if {[llength $args]==1} { + return $root[lindex $args 0]$suffix + } else { + return $root[lindex $args 0]$suffix?[join [lrange $args 1 end] &] + } +} + +proc cgi_suffix {args} { + global _cgi + if {[llength $args] > 0} { + set _cgi(suffix) [lindex $args 0] + } + if {![info exists _cgi(suffix)]} { + return .cgi + } else { + return $_cgi(suffix) + } +} + +proc cgi_cgi_set {variable value} { + regsub -all {%} $value "%25" value + regsub -all {&} $value "%26" value + regsub -all {\+} $value "%2b" value + regsub -all { } $value "+" value + regsub -all {=} $value "%3d" value + regsub -all {#} $value "%23" value + regsub -all {/} $value "%2f" value ;# Added... + return $variable=$value +} + +################################################## +# URL dictionary support +################################################## + +proc cgi_link {args} { + global _cgi_link + + set tag [lindex $args 0] + switch -- [llength $args] { + 1 { + set label $_cgi_link($tag,label) + } 2 { + set label [lindex $args end] + } default { + set _cgi_link($tag,label) [set label [lindex $args 1]] + set _cgi_link($tag,url) [lrange $args 2 end] + } + } + + return [eval cgi_url [list $label] $_cgi_link($tag,url)] +} + +# same as above but for images +# note: uses different namespace +proc cgi_imglink {args} { + global _cgi_imglink + + set tag [lindex $args 0] + if {[llength $args] >= 2} { + set _cgi_imglink($tag) [eval cgi_img [lrange $args 1 end]] + } + return $_cgi_imglink($tag) +} + +proc cgi_link_label {tag} { + global _cgi_link + return $_cgi_link($tag,label) +} + +proc cgi_link_url {tag} { + global _cgi_link + return $_cgi_link($tag,url) +} + +################################################## +# hyperlink support +################################################## + +# construct a hyperlink labeled "display" +# last arg is the link destination +# any other args are passed through into <a> display +proc cgi_url {display args} { + global _cgi + + set buf "<a href=\"[lindex $args 0]\"" + foreach a [lrange $args 1 end] { + if {[regexp $_cgi(attr,regexp) $a dummy attr str]} { + append buf " $attr=\"$str\"" + } else { + append buf " $a" + } + } + return "$buf>$display</a>" +} + +# generate an image reference (<img ...>) +# first arg is image url +# other args are passed through into <img> tag +proc cgi_img {args} { + global _cgi + + set buf "<img src=\"[lindex $args 0]\"" + foreach a [lrange $args 1 end] { + if {[regexp "^(alt|lowsrc|usemap)=(.*)" $a dummy attr str]} { + append buf " $attr=[cgi_dquote_html $str]" + } elseif {[regexp $_cgi(attr,regexp) $a dummy attr str]} { + append buf " $attr=\"$str\"" + } else { + append buf " $a" + } + } + return "$buf />" +} + +# names an anchor so that it can be linked to +proc cgi_anchor_name {name} { + return "<a name=\"$name\"/>" +} + +proc cgi_base {args} { + global _cgi + + cgi_put "<base" + foreach a $args { + if {[regexp "^href=(.*)" $a dummy str]} { + cgi_put " href=[cgi_dquote_html $str]" + } elseif {[regexp $_cgi(attr,regexp) $a dummy attr str]} { + cgi_put " $attr=\"$str\"" + } else { + cgi_put " $a" + } + } + cgi_puts " />" +} + +################################################## +# quoting support +################################################## + +if {[info tclversion] >= 8.2} { + proc cgi_unquote_input buf { + # rewrite "+" back to space + # protect \ from quoting another \ and throwing off other things + # replace line delimiters with newlines + set buf [string map -nocase [list + { } "\\" "\\\\" %0d%0a \n] $buf] + + # prepare to process all %-escapes + regsub -all -nocase {%([a-f0-9][a-f0-9])} $buf {\\u00\1} buf + + # process \u unicode mapped chars + encoding convertfrom $::_cgi(queryencoding) \ + [subst -novar -nocommand $buf] + } +} elseif {[info tclversion] >= 8.1} { + proc cgi_unquote_input buf { + # rewrite "+" back to space + regsub -all {\+} $buf { } buf + # protect \ from quoting another \ and throwing off other things + regsub -all {\\} $buf {\\\\} buf + + # replace line delimiters with newlines + regsub -all -nocase "%0d%0a" $buf "\n" buf + + # prepare to process all %-escapes + regsub -all -nocase {%([a-f0-9][a-f0-9])} $buf {\\u00\1} buf + # process \u unicode mapped chars + return [subst -novar -nocommand $buf] + } +} else { + proc cgi_unquote_input {buf} { + # rewrite "+" back to space + regsub -all {\+} $buf { } buf + # protect \ from quoting another \ and throwing off other things first + # protect $ from doing variable expansion + # protect [ from doing evaluation + # protect " from terminating string + regsub -all {([\\["$])} $buf {\\\1} buf + + # replace line delimiters with newlines + regsub -all -nocase "%0d%0a" $buf "\n" buf + # Mosaic sends just %0A. This is handled in the next command. + + # prepare to process all %-escapes + regsub -all -nocase {%([a-f0-9][a-f0-9])} $buf {[format %c 0x\1]} buf + # process %-escapes and undo all protection + eval return \"$buf\" + } +} + +# return string but with html-special characters escaped, +# necessary if you want to send unknown text to an html-formatted page. +proc cgi_quote_html {s} { + regsub -all {&} $s {\&} s ;# must be first! + regsub -all {"} $s {\"} s + regsub -all {<} $s {\<} s + regsub -all {>} $s {\>} s + return $s +} + +proc cgi_dquote_html {s} { + return \"[cgi_quote_html $s]\" +} + +# return string quoted appropriately to appear in a url +proc cgi_quote_url {in} { + regsub -all {%} $in "%25" in + regsub -all {\+} $in "%2b" in + regsub -all { } $in "%20" in + regsub -all {"} $in "%22" in + regsub -all {\?} $in "%3f" in + return $in +} + +################################################## +# short or single paragraph support +################################################## + +proc cgi_br {args} { + cgi_put "<br" + if {[llength $args]} { + cgi_put "[_cgi_list_to_string $args]" + } + cgi_put " />" +} + +# generate cgi_h1 and others +for {set _cgi(tmp) 1} {$_cgi(tmp)<8} {incr _cgi(tmp)} { + proc cgi_h$_cgi(tmp) {{args}} "eval cgi_h $_cgi(tmp) \$args" +} +proc cgi_h {num args} { + cgi_put "<h$num" + if {[llength $args] > 1} { + cgi_put "[_cgi_lrange $args 0 [expr [llength $args]-2]]" + set args [lrange $args end end] + } + cgi_put ">[lindex $args 0]</h$num>" +} + +proc cgi_p {args} { + cgi_put "<p" + if {[llength $args] > 1} { + cgi_put "[_cgi_lrange $args 0 [expr [llength $args]-2]]" + set args [lrange $args end end] + } + cgi_put ">[lindex $args 0]</p>" +} + +proc cgi_address {s} {cgi_put <address>$s</address>} +proc cgi_blockquote {s} {cgi_puts <blockquote>$s</blockquote>} + +################################################## +# long or multiple paragraph support +################################################## + +# Shorthand for <div align=center>. We used to use <center> tags but that +# is now officially unsupported. +proc cgi_center {cmd} { + uplevel 1 "cgi_division align=center [list $cmd]" +} + +proc cgi_division {args} { + cgi_put "<div" + _cgi_close_proc_push "cgi_put </div>" + + if {[llength $args]} { + cgi_put "[_cgi_lrange $args 0 [expr {[llength $args]-2}]]" + } + cgi_put ">" + uplevel 1 [lindex $args end] + _cgi_close_proc +} + +proc cgi_preformatted {args} { + cgi_put "<pre" + _cgi_close_proc_push "cgi_put </pre>" + + if {[llength $args]} { + cgi_put "[_cgi_lrange $args 0 [expr [llength $args]-2]]" + } + cgi_put ">" + uplevel 1 [lindex $args end] + _cgi_close_proc +} + +################################################## +# list support +################################################## + +proc cgi_li {args} { + cgi_put <li + if {[llength $args] > 1} { + cgi_put "[_cgi_lrange $args 0 [expr [llength $args]-2]]" + } + cgi_put ">[lindex $args end]</li>" +} + +proc cgi_number_list {args} { + cgi_put "<ol" + _cgi_close_proc_push "cgi_put </ol>" + + if {[llength $args] > 1} { + cgi_put "[_cgi_lrange $args 0 [expr [llength $args]-2]]" + } + cgi_put ">" + uplevel 1 [lindex $args end] + + _cgi_close_proc +} + +proc cgi_bullet_list {args} { + cgi_put "<ul" + _cgi_close_proc_push "cgi_put </ul>" + + if {[llength $args] > 1} { + cgi_put "[_cgi_lrange $args 0 [expr [llength $args]-2]]" + } + cgi_put ">" + uplevel 1 [lindex $args end] + + _cgi_close_proc +} + +# Following two are normally used from within definition lists +# but are actually paragraph types on their own. +proc cgi_term {s} {cgi_put <dt>$s</dt>} +proc cgi_term_definition {s} {cgi_put <dd>$s</dd>} + +proc cgi_definition_list {cmd} { + cgi_put "<dl>" + _cgi_close_proc_push "cgi_put </dl>" + + uplevel 1 $cmd + _cgi_close_proc +} + +proc cgi_menu_list {cmd} { + cgi_put "<menu>" + _cgi_close_proc_push "cgi_put </menu>" + + uplevel 1 $cmd + _cgi_close_proc +} +proc cgi_directory_list {cmd} { + cgi_put "<dir>" + _cgi_close_proc_push "cgi_put </dir>" + + uplevel 1 $cmd + _cgi_close_proc +} + +################################################## +# text support +################################################## + +proc cgi_put {s} {cgi_puts -nonewline $s} + +# some common special characters +proc cgi_lt {} {return "<"} +proc cgi_gt {} {return ">"} +proc cgi_amp {} {return "&"} +proc cgi_quote {} {return """} +proc cgi_enspace {} {return " "} +proc cgi_emspace {} {return " "} +proc cgi_nbspace {} {return " "} ;# nonbreaking space +proc cgi_tm {} {return "®"} ;# registered trademark +proc cgi_copyright {} {return "©"} +proc cgi_isochar {n} {return "&#$n;"} +proc cgi_breakable {} {return "<wbr />"} + +proc cgi_unbreakable_string {s} {return "<nobr>$s</nobr>"} +proc cgi_unbreakable {cmd} { + cgi_put "<nobr>" + _cgi_close_proc_push "cgi_put </nobr>" + uplevel 1 $cmd + _cgi_close_proc +} + +proc cgi_nl {args} { + set buf "<br" + if {[llength $args]} { + append buf "[_cgi_list_to_string $args]" + } + return "$buf />" +} + +proc cgi_bold {s} {return "<b>$s</b>"} +proc cgi_italic {s} {return "<i>$s</i>"} +proc cgi_underline {s} {return "<u>$s</u>"} +proc cgi_strikeout {s} {return "<s>$s</s>"} +proc cgi_subscript {s} {return "<sub>$s</sub>"} +proc cgi_superscript {s} {return "<sup>$s</sup>"} +proc cgi_typewriter {s} {return "<tt>$s</tt>"} +proc cgi_blink {s} {return "<blink>$s</blink>"} +proc cgi_emphasis {s} {return "<em>$s</em>"} +proc cgi_strong {s} {return "<strong>$s</strong>"} +proc cgi_cite {s} {return "<cite>$s</cite>"} +proc cgi_sample {s} {return "<samp>$s</samp>"} +proc cgi_keyboard {s} {return "<kbd>$s</kbd>"} +proc cgi_variable {s} {return "<var>$s</var>"} +proc cgi_definition {s} {return "<dfn>$s</dfn>"} +proc cgi_big {s} {return "<big>$s</big>"} +proc cgi_small {s} {return "<small>$s</small>"} + +proc cgi_basefont {size} {cgi_put "<basefont size=$size />"} + +proc cgi_font {args} { + global _cgi + + set buf "<font" + foreach a [lrange $args 0 [expr [llength $args]-2]] { + if {[regexp $_cgi(attr,regexp) $a dummy attr str]} { + append buf " $attr=\"$str\"" + } else { + append buf " $a" + } + } + return "$buf>[lindex $args end]</font>" +} + +# take a cgi func and have it return what would normally print +# This command is reentrant (that's why it's so complex). +proc cgi_buffer {cmd} { + global _cgi + + if {0==[info exists _cgi(returnIndex)]} { + set _cgi(returnIndex) 0 + } + + rename cgi_puts cgi_puts$_cgi(returnIndex) + incr _cgi(returnIndex) + set _cgi(return[set _cgi(returnIndex)]) "" + + proc cgi_puts args { + global _cgi + upvar #0 _cgi(return[set _cgi(returnIndex)]) buffer + + append buffer [lindex $args end] + if {[llength $args] == 1} { + append buffer $_cgi(buffer_nl) + } + } + + # must restore things before allowing the eval to fail + # so catch here and rethrow later + if {[catch {uplevel 1 $cmd} errMsg]} { + global errorInfo + set savedInfo $errorInfo + } + + # not necessary to put remainder of code in close_proc_push since it's + # all buffered anyway and hasn't yet put browser into a funky state. + + set buffer $_cgi(return[set _cgi(returnIndex)]) + + incr _cgi(returnIndex) -1 + rename cgi_puts "" + rename cgi_puts$_cgi(returnIndex) cgi_puts + + if {[info exists savedInfo]} { + error $errMsg $savedInfo + } + return $buffer +} + +set _cgi(buffer_nl) "\n" +proc cgi_buffer_nl {nl} { + global _cgi + + set old $_cgi(buffer_nl) + set _cgi(buffer_nl) $nl + return $old +} + +################################################## +# html and tags that can appear in html top-level +################################################## + +proc cgi_html {args} { + set html [lindex $args end] + set argc [llength $args] + if {$argc > 1} { + eval _cgi_html_start [lrange $args 0 [expr {$argc-2}]] + } else { + _cgi_html_start + } + uplevel 1 $html + _cgi_html_end +} + +proc _cgi_html_start {args} { + global _cgi + + if {[info exists _cgi(html_in_progress)]} return + _cgi_http_head_implicit + + set _cgi(html_in_progress) 1 + cgi_doctype + + append buf "<html" + foreach a $args { + if {[regexp $_cgi(attr,regexp) $a dummy attr str]} { + append buf " $attr=\"$str\"" + } else { + append buf " $a" + } + } + cgi_puts "$buf>" +} + +proc _cgi_html_end {} { + global _cgi + unset _cgi(html_in_progress) + set _cgi(html_done) 1 + cgi_puts "</html>" +} + +# force closure of all tags and exit without going through normal returns. +# Very useful if you want to call exit from a deeply stacked CGI script +# and still have the HTML be correct. +proc cgi_exit {} { + _cgi_close_procs + cgi_html {cgi_body {}} + exit +} + +################################################## +# head support +################################################## + +proc cgi_head {{head {}}} { + global _cgi + + if {[info exists _cgi(head_done)]} { + return + } + + # allow us to be recalled so that we can display errors + if {0 == [info exists _cgi(head_in_progress)]} { + _cgi_http_head_implicit + set _cgi(head_in_progress) 1 + cgi_puts "<head>" + } + + # prevent cgi_html (during error handling) from generating html tags + set _cgi(html_in_progress) 1 + # don't actually generate html tags since there's nothing to clean + # them up + + if {0 == [string length $head]} { + if {[catch {cgi_title}]} { + set head "cgi_title untitled" + } + } + uplevel 1 $head + if {![info exists _cgi(head_suppress_tag)]} { + cgi_puts "</head>" + } else { + unset _cgi(head_suppress_tag) + } + + set _cgi(head_done) 1 + + # debugging can unset this in the uplevel above + catch {unset _cgi(head_in_progress)} +} + +# with one arg: set, print, and return title +# with no args: return title +proc cgi_title {args} { + global _cgi + + set title [lindex $args 0] + + if {[llength $args]} { + _cgi_http_head_implicit + + # we could just generate <head></head> tags, but head-level commands + # might follow so just suppress the head tags entirely + if {![info exists _cgi(head_in_progress)]} { + set _cgi(head_in_progress) 1 + set _cgi(head_suppress_tag) 1 + } + + set _cgi(title) $title + cgi_puts "<title>$title</title>" + } + return $_cgi(title) +} + +# This tag can only be called from with cgi_head. +# example: cgi_http_equiv Refresh 1 +# There's really no reason to call this since it can be done directly +# from cgi_http_head. +proc cgi_http_equiv {type contents} { + _cgi_http_head_implicit + cgi_puts "<meta http-equiv=\"$type\" content=[cgi_dquote_html $contents]/>" +} + +# Do whatever you want with meta tags. +# Example: <meta name="author" content="Don Libes"> +proc cgi_meta {args} { + cgi_put "<meta" + foreach a $args { + if {[regexp "^(name|content|http-equiv)=(.*)" $a dummy attr str]} { + cgi_put " $attr=[cgi_dquote_html $str]" + } else { + cgi_put " $a" + } + } + cgi_puts " />" +} + +proc cgi_relationship {rel href args} { + cgi_puts "<link rel=$rel href=\"$href\"" + foreach a $args { + if {[regexp "^title=(.*)" $a dummy str]} { + cgi_put " title=[cgi_dquote_html $str]" + } elseif {[regexp "^type=(.*)" $a dummy str]} { + cgi_put " type=[cgi_dquote_html $str]" + } else { + cgi_put " $a" + } + } + cgi_puts "/>" +} + +proc cgi_name {args} { + global _cgi + + if {[llength $args]} { + set _cgi(name) [lindex $args 0] + } + return $_cgi(name) +} + +################################################## +# body and other top-level support +################################################## + +proc cgi_body {args} { + global errorInfo errorCode _cgi + + # allow user to "return" from the body without missing _cgi_body_end + if {1==[catch { + eval _cgi_body_start [lrange $args 0 [expr [llength $args]-2]] + uplevel 1 [lindex $args end] + } errMsg]} { + set savedInfo $errorInfo + set savedCode $errorCode + error $errMsg $savedInfo $savedCode + } + _cgi_body_end +} + +proc _cgi_body_start {args} { + global _cgi + if {[info exists _cgi(body_in_progress)]} return + + cgi_head + + set _cgi(body_in_progress) 1 + + cgi_put "<body" + foreach a "$args $_cgi(body_args)" { + if {[regexp "^(background|bgcolor|text|link|vlink|alink|onLoad|onUnload)=(.*)" $a dummy attr str]} { + cgi_put " $attr=\"$str\"" + } else { + cgi_put " $a" + } + } + cgi_puts ">" + + cgi_debug { + global env + catch {cgi_puts "Input: <pre>$_cgi(input)</pre>"} + catch {cgi_puts "Cookie: <pre>$env(HTTP_COOKIE)</pre>"} + } + + if {![info exists _cgi(errorInfo)]} { + uplevel 2 app_body_start + } +} + +proc _cgi_body_end {} { + global _cgi + if {![info exists _cgi(errorInfo)]} { + uplevel 2 app_body_end + } + unset _cgi(body_in_progress) + cgi_puts "</body>" + + if {[info exists _cgi(multipart)]} { + unset _cgi(http_head_done) + catch {unset _cgi(http_status_done)} + unset _cgi(head_done) + catch {unset _cgi(head_suppress_tag)} + } +} + +proc cgi_body_args {args} { + global _cgi + + set _cgi(body_args) $args +} + +proc cgi_script {args} { + cgi_puts "<script[_cgi_lrange $args 0 [expr [llength $args]-2]]>" + _cgi_close_proc_push "cgi_puts </script>" + + uplevel 1 [lindex $args end] + + _cgi_close_proc +} + +proc cgi_javascript {args} { + cgi_puts "<script[_cgi_lrange $args 0 [expr [llength $args]-2]]>" + cgi_puts "<!--- Hide script from browsers that don't understand JavaScript" + _cgi_close_proc_push {cgi_puts "// End hiding -->\n</script>"} + + uplevel 1 [lindex $args end] + + _cgi_close_proc +} + +proc cgi_noscript {args} { + cgi_puts "<noscript[_cgi_lrange $args 0 [expr [llength $args]-2]]>" + _cgi_close_proc_push {cgi_puts "</noscript>"} + + uplevel 1 [lindex $args end] + + _cgi_close_proc +} + +proc cgi_applet {args} { + cgi_puts "<applet[_cgi_lrange $args 0 [expr [llength $args]-2]]>" + _cgi_close_proc_push "cgi_puts </applet>" + + uplevel 1 [lindex $args end] + _cgi_close_proc +} + +proc cgi_param {nameval} { + regexp "(\[^=]*)(=?)(.*)" $nameval dummy name q value + + if {$q != "="} { + set value "" + } + cgi_puts "<param name=\"$name\" value=[cgi_dquote_html $value]/>" +} + +# record any proc's that must be called prior to displaying an error +proc _cgi_close_proc_push {p} { + global _cgi + if {![info exists _cgi(close_proc)]} { + set _cgi(close_proc) "" + } + set _cgi(close_proc) "$p; $_cgi(close_proc)" +} + +proc _cgi_close_proc_pop {} { + global _cgi + regexp "^(\[^;]*);(.*)" $_cgi(close_proc) dummy lastproc _cgi(close_proc) + return $lastproc +} + +# generic proc to close whatever is on the top of the stack +proc _cgi_close_proc {} { + eval [_cgi_close_proc_pop] +} + +proc _cgi_close_procs {} { + global _cgi + + _cgi_close_tag + if {[info exists _cgi(close_proc)]} { + uplevel #0 $_cgi(close_proc) + } +} + +proc _cgi_close_tag {} { + global _cgi + + if {[info exists _cgi(tag_in_progress)]} { + cgi_put ">" + unset _cgi(tag_in_progress) + } +} + +################################################## +# hr support +################################################## + +proc cgi_hr {args} { + set buf "<hr" + foreach a $args { + if {[regexp "^width=(.*)" $a dummy str]} { + append buf " width=\"$str\"" + } else { + append buf " $a" + } + } + cgi_put "$buf />" +} + +################################################## +# form & isindex +################################################## + +proc cgi_form {action args} { + global _cgi + + _cgi_form_multiple_check + set _cgi(form_in_progress) 1 + + _cgi_close_proc_push _cgi_form_end + cgi_put "<form action=" + if {[regexp {^[a-z]*:} $action]} { + cgi_put "\"$action\"" + } else { + cgi_put "\"[cgi_cgi $action]\"" + } + set method "method=post" + foreach a [lrange $args 0 [expr [llength $args]-2]] { + if {[regexp "^method=" $a]} { + set method $a + } elseif {[regexp "^(target|onReset|onSubmit)=(.*)" $a dummy attr str]} { + cgi_put " $attr=\"$str\"" + } elseif {[regexp "^enctype=(.*)" $a dummy str]} { + cgi_put " enctype=\"$str\"" + set _cgi(form,enctype) $str + } else { + cgi_put " $a" + } + } + cgi_put " $method>" + uplevel 1 [lindex $args end] + catch {unset _cgi(form,enctype)} + _cgi_close_proc +} + +proc _cgi_form_end {} { + global _cgi + unset _cgi(form_in_progress) + cgi_put "</form>" +} + +proc _cgi_form_multiple_check {} { + global _cgi + if {[info exists _cgi(form_in_progress)]} { + error "Cannot create form (or isindex) with form already in progress." + } +} + +proc cgi_isindex {args} { + _cgi_form_multiple_check + + cgi_put "<isindex" + foreach a $args { + if {[regexp "^href=(.*)" $a dummy str]} { + cgi_put " href=\"$str\"" + } elseif {[regexp "^prompt=(.*)" $a dummy str]} { + cgi_put " prompt=[cgi_dquote_html $str]" + } else { + cgi_put " $a" + } + } + cgi_put "/>" +} + +################################################## +# argument handling +################################################## + +proc cgi_input {{fakeinput {}} {fakecookie {}}} { + global env _cgi _cgi_uservar _cgi_cookie _cgi_cookie_shadowed + + set _cgi(uservars) {} + set _cgi(uservars,autolist) {} + + if {[info exists env(CONTENT_TYPE)] && [regexp ^multipart/form-data $env(CONTENT_TYPE)]} { + if {![info exists env(REQUEST_METHOD)]} { + # running by hand + set fid [open $fakeinput] + } else { + set fid stdin + } + if {([info tclversion] >= 8.1) || [catch exp_version] || [info exists _cgi(no_binary_upload)]} { + _cgi_input_multipart $fid + } else { + _cgi_input_multipart_binary $fid + } + } else { + if {![info exists env(REQUEST_METHOD)]} { + set input $fakeinput + set env(HTTP_COOKIE) $fakecookie + } elseif { $env(REQUEST_METHOD) == "GET" } { + set input "" + catch {set input $env(QUERY_STRING)} ;# doesn't have to be set + } elseif { $env(REQUEST_METHOD) == "HEAD" } { + set input "" + } elseif {![info exists env(CONTENT_LENGTH)]} { + set _cgi(client_error) 1 + error "Your browser failed to generate the content-length during a POST method." + } else { + set length $env(CONTENT_LENGTH) + if {0!=[string compare $length "-1"]} { + set input [read stdin $env(CONTENT_LENGTH)] + } else { + set _cgi(client_error) 1 + error "Your browser generated a content-length of -1 during a POST method." + } + if {[info tclversion] >= 8.1} { + # guess query encoding from Content-Type header + if {[info exists env(CONTENT_TYPE)] \ + && [regexp -nocase -- {charset=([^[:space:]]+)} $env(CONTENT_TYPE) m cs]} { + if {[regexp -nocase -- {iso-?8859-([[:digit:]]+)} $cs m d]} { + set _cgi(queryencoding) "iso8859-$d" + } elseif {[regexp -nocase -- {windows-([[:digit:]]+)} $cs m d]} { + set _cgi(queryencoding) "cp$d" + } elseif {0==[string compare -nocase $cs "utf-8"]} { + set _cgi(queryencoding) "utf-8" + } elseif {0==[string compare -nocase $cs "utf-16"]} { + set _cgi(queryencoding) "unicode" + } + } else { + set _cgi(queryencoding) [encoding system] + } + } + } + # save input for possible diagnostics later + set _cgi(input) $input + + set pairs [split $input &] + foreach pair $pairs { + if {0 == [regexp "^(\[^=]*)=(.*)$" $pair dummy varname val]} { + # if no match, unquote and leave it at that + # this is typical of <isindex>-style queries + set varname anonymous + set val $pair + } + + set varname [cgi_unquote_input $varname] + set val [cgi_unquote_input $val] + _cgi_set_uservar $varname $val + } + } + + # O'Reilly's web server incorrectly uses COOKIE + catch {set env(HTTP_COOKIE) $env(COOKIE)} + if {![info exists env(HTTP_COOKIE)]} return + foreach pair [split $env(HTTP_COOKIE) ";"] { + # pairs are actually split by "; ", sigh + set pair [string trimleft $pair " "] + # spec is not clear but seems to allow = unencoded + # only sensible interpretation is to assume no = in var names + # appears MS IE can omit "=val" + set val "" + regexp (\[^=]*)=?(.*) $pair dummy varname val + + set varname [cgi_unquote_input $varname] + set val [cgi_unquote_input $val] + + if {[info exists _cgi_cookie($varname)]} { + lappend _cgi_cookie_shadowed($varname) $val + } else { + set _cgi_cookie($varname) $val + } + } +} + +proc _cgi_input_multipart {fin} { + global env _cgi _cgi_uservar _cgi_userfile + + cgi_debug -noprint { + # save file for debugging purposes + set dbg_filename [file join $_cgi(tmpdir) CGIdbg.[pid]] + # explicitly flush all writes to fout, because sometimes the writer + # can hang and we won't get to the termination code + set dbg_fout [open $dbg_filename w $_cgi(tmpperms)] + set _cgi(input) $dbg_filename + catch {fconfigure $dbg_fout -translation binary} + } + + # figure out boundary + if {0==[regexp boundary=(.*) $env(CONTENT_TYPE) dummy boundary]} { + set _cgi(client_error) 1 + error "Your browser failed to generate a \"boundary=\" line in a multipart response (CONTENT_TYPE: $env(CONTENT_TYPE)). Please upgrade (or fix) your browser." + } + + # make boundary into a legal regsub pattern by protecting # + # legal boundary characters include ()+.? (among others) + regsub -all "\\(" $boundary "\\(" boundary + regsub -all "\\)" $boundary "\\)" boundary + regsub -all "\\+" $boundary "\\+" boundary + regsub -all "\\." $boundary "\\." boundary + regsub -all "\\?" $boundary "\\?" boundary + + set boundary --$boundary + + # don't corrupt or modify uploads yet allow Tcl 7.4 to work + catch {fconfigure $fin -translation binary} + + # get first boundary line + gets $fin buf + if {[info exists dbg_fout]} {puts $dbg_fout $buf; flush $dbg_fout} + + set _cgi(file,filecount) 0 + + while {1} { + # process Content-Disposition: + if {-1 == [gets $fin buf]} break + if {[info exists dbg_fout]} {puts $dbg_fout $buf; flush $dbg_fout} + catch {unset filename} + regexp {name="([^"]*)"} $buf dummy varname + if {0==[info exists varname]} { + # lynx violates spec and doesn't use quotes, so try again but + # assume space is delimiter + regexp {name=([^ ]*)} $buf dummy varname + if {0==[info exists varname]} { + set _cgi(client_error) 1 + error "In response to a request for a multipart form, your browser generated a part header without a name field. Please upgrade (or fix) your browser." + } + } + # Lame-o encoding (on Netscape at least) doesn't escape field + # delimiters (like quotes)!! Since all we've ever seen is filename= + # at end of line, assuming nothing follows. Sigh. + regexp {filename="(.*)"} $buf dummy filename + + # Skip remaining headers until blank line. + # Content-Type: can appear here. + set conttype "" + while {1} { + if {-1 == [gets $fin buf]} break + if {[info exists dbg_fout]} {puts $dbg_fout $buf; flush $dbg_fout} + if {0==[string compare $buf "\r"]} break + regexp -nocase "^Content-Type:\[ \t]+(.*)\r" $buf x conttype + } + + if {[info exists filename]} { + if {$_cgi(file,filecount) > $_cgi(file,filelimit)} { + error "Too many files submitted. Max files allowed: $_cgi(file,filelimit)" + } + + # read the part into a file + set foutname [file join $_cgi(tmpdir) CGI[pid].[incr _cgi(file,filecount)]] + set fout [open $foutname w $_cgi(tmpperms)] + # "catch" permits this to work with Tcl 7.4 + catch {fconfigure $fout -translation binary} + _cgi_set_uservar $varname [list $foutname $filename $conttype] + set _cgi_userfile($varname) [list $foutname $filename $conttype] + + # + # Look for a boundary line preceded by \r\n. + # + # To do this, we buffer line terminators that might + # be the start of the special \r\n$boundary sequence. + # The buffer is called "leftover" and is just inserted + # into the front of the next output (assuming it's + # not a boundary line). + + set leftover "" + while {1} { + if {-1 == [gets $fin buf]} break + if {[info exists dbg_fout]} {puts $dbg_fout $buf; flush $dbg_fout} + + if {0 == [string compare "\r\n" $leftover]} { + if {[regexp ^[set boundary](--)?\r?$ $buf dummy dashdash]} { + if {$dashdash == "--"} {set eof 1} + break + } + } + if {[regexp (.*)\r$ $buf x data]} { + puts -nonewline $fout $leftover$data + set leftover "\r\n" + } else { + puts -nonewline $fout $leftover$buf + set leftover "\n" + } + if {[file size $foutname] > $_cgi(file,charlimit)} { + error "File size exceeded. Max file size allowed: $_cgi(file,charlimit)" + } + } + + close $fout + unset fout + } else { + # read the part into a variable + set val "" + set blanks 0 + while {1} { + if {-1 == [gets $fin buf]} break + if {[info exists dbg_fout]} {puts $dbg_fout $buf; flush $dbg_fout} + if {[regexp ^[set boundary](--)?\r?$ $buf dummy dashdash]} { + if {$dashdash == "--"} {set eof 1} + break + } + if {0!=[string compare $val ""]} { + append val \n + } + regexp (.*)\r$ $buf dummy buf + if {[info exists blanks]} { + if {0!=[string compare $buf ""]} { + if {$blanks} { + append val [string repeat \n [incr blanks]] + } + unset blanks + } else { + incr blanks + } + } + append val $buf + } + _cgi_set_uservar $varname $val + } + if {[info exists eof]} break + } + if {[info exists dbg_fout]} {close $dbg_fout} +} + +proc _cgi_input_multipart_binary {fin} { + global env _cgi _cgi_uservar _cgi_userfile + + log_user 0 + set timeout -1 + + cgi_debug -noprint { + # save file for debugging purposes + set dbg_filename [file join $_cgi(tmpdir) CGIdbg.[pid]] + set _cgi(input) $dbg_filename + spawn -open [open $dbg_filename w $_cgi(tmpperms)] + set dbg_sid $spawn_id + } + spawn -open $fin + set fin_sid $spawn_id + remove_nulls 0 + + if {0} { + # dump input to screen + cgi_debug { + puts "<xmp>" + expect { + -i $fin_sid + -re ^\r {puts -nonewline "CR"; exp_continue} + -re ^\n {puts "NL"; exp_continue} + -re . {puts -nonewline $expect_out(buffer); exp_continue} + } + puts "</xmp>" + exit + } + } + + # figure out boundary + if {0==[regexp boundary=(.*) $env(CONTENT_TYPE) dummy boundary]} { + set _cgi(client_error) 1 + error "Your browser failed to generate a \"boundary=\" definition in a multipart response (CONTENT_TYPE: $env(CONTENT_TYPE)). Please upgrade (or fix) your browser." + } + + # make boundary into a legal regsub pattern by protecting # + # legal boundary characters include ()+.? (among others) + regsub -all "\\(" $boundary "\\(" boundary + regsub -all "\\)" $boundary "\\)" boundary + regsub -all "\\+" $boundary "\\+" boundary + regsub -all "\\." $boundary "\\." boundary + regsub -all "\\?" $boundary "\\?" boundary + + set boundary --$boundary + set linepat "(\[^\r]*)\r\n" + + # get first boundary line + expect { + -i $fin_sid + -re $linepat { + set buf $expect_out(1,string) + if {[info exists dbg_sid]} {send -i $dbg_sid -- $buf\n} + } + eof { + set _cgi(client_error) 1 + error "Your browser failed to provide an initial boundary ($boundary) in a multipart response. Please upgrade (or fix) your browser." + } + } + + set _cgi(file,filecount) 0 + + while {1} { + # process Content-Disposition: + expect { + -i $fin_sid + -re $linepat { + set buf $expect_out(1,string) + if {[info exists dbg_sid]} {send -i $dbg_sid -- $buf\n} + } + eof break + } + catch {unset filename} + regexp {name="([^"]*)"} $buf dummy varname + if {0==[info exists varname]} { + set _cgi(client_error) 1 + error "In response to a request for a multipart form, your browser generated a part header without a name field. Please upgrade (or fix) your browser." + } + + # Lame-o encoding (on Netscape at least) doesn't escape field + # delimiters (like quotes)!! Since all we've ever seen is filename= + # at end of line, assuming nothing follows. Sigh. + regexp {filename="(.*)"} $buf dummy filename + + # Skip remaining headers until blank line. + # Content-Type: can appear here. + set conttype "" + expect { + -i $fin_sid + -re $linepat { + set buf $expect_out(1,string) + if {[info exists dbg_sid]} {send -i $dbg_sid -- $buf\n} + if {0!=[string compare $buf ""]} exp_continue + regexp -nocase "^Content-Type:\[ \t]+(.*)\r" $buf x conttype + } + eof break + } + + if {[info exists filename]} { + if {$_cgi(file,filecount) > $_cgi(file,filelimit)} { + error "Too many files submitted. Max files allowed: $_cgi(file,filelimit)" + } + + # read the part into a file + set foutname [file join $_cgi(tmpdir) CGI[pid].[incr _cgi(file,filecount)]] + spawn -open [open $foutname w $_cgi(tmpperms)] + set fout_sid $spawn_id + + _cgi_set_uservar $varname [list $foutname $filename $conttype] + set _cgi_userfile($varname) [list $foutname $filename $conttype] + + # This is tricky stuff - be very careful changing anything here! + # In theory, all we have to is record everything up to + # \r\n$boundary\r\n. Unfortunately, we can't simply wait on + # such a pattern because the input can overflow any possible + # buffer we might choose. We can't simply catch buffer_full + # because the boundary might straddle a buffer. I doubt that + # doing my own buffering would be any faster than taking the + # approach I've done here. + # + # The code below basically implements a simple scanner that + # keeps track of whether it's seen crlfs or pieces of them. + # The idea is that we look for crlf pairs, separated by + # things that aren't crlfs (or pieces of them). As we encounter + # things that aren't crlfs (or pieces of them), or when we decide + # they can't be, we mark them for output and resume scanning for + # new pairs. + # + # The scanner runs tolerably fast because the [...]+ pattern picks + # up most things. The \r and \n are ^-anchored so the pattern + # match is pretty fast and these don't happen that often so the + # huge \n action is executed rarely (once per line on text files). + # The null pattern is, of course, only used when everything + # else fails. + + # crlf == "\r\n" if we've seen one, else == "" + # cr == "\r" if we JUST saw one, else == "" + # Yes, strange, but so much more efficient + # that I'm willing to sacrifice readability, sigh. + # buf accumulated data between crlf pairs + + set buf "" + set cr "" + set crlf "" + + expect { + -i $fin_sid + -re "^\r" { + if {$cr == "\r"} { + append buf "\r" + } + set cr \r + exp_continue + } -re "^\n" { + if {$cr == "\r"} { + if {$crlf == "\r\n"} { + # do boundary test + if {[regexp ^[set boundary](--)?$ $buf dummy dashdash]} { + if {$dashdash == "--"} { + set eof 1 + } + } else { + # boundary test failed + if {[info exists dbg_sid]} {send -i $dbg_sid -- \r\n$buf} + send -i $fout_sid \r\n$buf ; set buf "" + set cr "" + exp_continue + } + } else { + set crlf "\r\n" + set cr "" + if {[info exists dbg_sid]} {send -i $dbg_sid -- $buf} + send -i $fout_sid -- $buf ; set buf "" + exp_continue + } + } else { + if {[info exists dbg_sid]} {send -i $dbg_sid -- $crlf$buf\n} + send -i $fout_sid -- $crlf$buf\n ; set buf "" + set crlf "" + exp_continue + } + } -re "\[^\r\n]+" { + if {$cr == "\r"} { + set buf $crlf$buf\r$expect_out(buffer) + set crlf "" + set cr "" + } else { + append buf $expect_out(buffer) + } + exp_continue + } null { + if {[info exists dbg_sid]} { + send -i $dbg_sid -- $crlf$buf$cr + send -i $dbg_sid -null + } + send -i $fout_sid -- $crlf$buf$cr ; set buf "" + send -i $fout_sid -null + set cr "" + set crlf "" + exp_continue + } eof { + set _cgi(client_error) 1 + error "Your browser failed to provide an ending boundary ($boundary) in a multipart response. Please upgrade (or fix) your browser." + } + } + exp_close -i $fout_sid ;# implicitly closes fout + exp_wait -i $fout_sid + unset fout_sid + } else { + # read the part into a variable + set val "" + expect { + -i $fin_sid + -re $linepat { + set buf $expect_out(1,string) + if {[info exists dbg_sid]} {send -i $dbg_sid -- $buf\n} + if {[regexp ^[set boundary](--)?$ $buf dummy dashdash]} { + if {$dashdash == "--"} {set eof 1} + } else { + regexp (.*)\r$ $buf dummy buf + if {0!=[string compare $val ""]} { + append val \n + } + append val $buf + exp_continue + } + } + } + _cgi_set_uservar $varname $val + } + if {[info exists eof]} break + } + if {[info exists fout]} { + exp_close -i $dbg_sid + exp_wait -i $dbg_sid + } + + # no need to close fin, fin_sid, or dbg_sid +} + +# internal routine for defining user variables +proc _cgi_set_uservar {varname val} { + global _cgi _cgi_uservar + + set exists [info exists _cgi_uservar($varname)] + set isList $exists + # anything we've seen before and is being set yet again necessarily + # has to be (or become a list) + + if {!$exists} { + lappend _cgi(uservars) $varname + } + + if {[regexp List$ $varname]} { + set isList 1 + } elseif {$exists} { + # vars that we've seen before but aren't marked as lists + # need to be "listified" so we can do appends later + if {-1 == [lsearch $_cgi(uservars,autolist) $varname]} { + # remember that we've listified it + lappend _cgi(uservars,autolist) $varname + set _cgi_uservar($varname) [list $_cgi_uservar($varname)] + } + } + if {$isList} { + lappend _cgi_uservar($varname) $val + } else { + set _cgi_uservar($varname) $val + } +} + +# export named variable +proc cgi_export {nameval} { + regexp "(\[^=]*)(=?)(.*)" $nameval dummy name q value + + if {$q != "="} { + set value [uplevel 1 set [list $name]] + } + + cgi_put "<input type=hidden name=\"$name\" value=[cgi_dquote_html $value]/>" +} + +proc cgi_export_cookie {name args} { + upvar 1 $name x + eval cgi_cookie_set [list $name=$x] $args +} + +# return list of variables available for import +# Explicit list is used to keep items in order originally found in form. +proc cgi_import_list {} { + global _cgi + + return $_cgi(uservars) +} + +# import named variable +proc cgi_import {name} { + global _cgi_uservar + upvar 1 $name var + + set var $_cgi_uservar($name) +} + +proc cgi_import_as {name tclvar} { + global _cgi_uservar + upvar 1 $tclvar var + + set var $_cgi_uservar($name) +} + +# like cgi_import but if not available, try cookie +proc cgi_import_cookie {name} { + global _cgi_uservar + upvar 1 $name var + + if {0==[catch {set var $_cgi_uservar($name)}]} return + set var [cgi_cookie_get $name] +} + +# like cgi_import but if not available, try cookie +proc cgi_import_cookie_as {name tclvar} { + global _cgi_uservar + upvar 1 $tclvar var + + if {0==[catch {set var $_cgi_uservar($name)}]} return + set var [cgi_cookie_get $name] +} + +proc cgi_import_file {type name} { + global _cgi_userfile + upvar 1 $name var + + set var $_cgi_userfile($name) + switch -- $type { + "-server" { + lindex $var 0 + } "-client" { + lindex $var 1 + } "-type" { + lindex $var 2 + } + } +} + +# deprecated, use cgi_import_file +proc cgi_import_filename {type name} { + global _cgi_userfile + upvar 1 $name var + + set var $_cgi_userfile($name) + if {$type == "-server" || $type == "-local"} { + # -local is deprecated + lindex $var 0 + } else { + lindex $var 1 + } +} + +# set the urlencoding +proc cgi_urlencoding {{encoding ""}} { + global _cgi + + set result [expr {[info exists _cgi(queryencoding)] + ? $_cgi(queryencoding) + : ""}] + + # check if the encoding is available + if {[info tclversion] >= 8.1 + && [lsearch -exact [encoding names] $encoding] != -1 } { + set _cgi(queryencoding) $encoding + } + + return $result +} + +################################################## +# button support +################################################## + +# not sure about arg handling, do we need to support "name="? +proc cgi_button {value args} { + cgi_put "<input type=button value=[cgi_dquote_html $value]" + foreach a $args { + if {[regexp "^onClick=(.*)" $a dummy str]} { + cgi_put " onClick=\"$str\"" + } else { + cgi_put " $a" + } + } + cgi_put "/>" +} + +# Derive a button from a link predefined by cgi_link +proc cgi_button_link {args} { + global _cgi_link + + set tag [lindex $args 0] + if {[llength $args] == 2} { + set label [lindex $args end] + } else { + set label $_cgi_link($tag,label) + } + + cgi_button $label onClick=$_cgi_link($tag,url) +} + +proc cgi_submit_button {{nameval {=Submit Query}} args} { + regexp "(\[^=]*)=(.*)" $nameval dummy name value + cgi_put "<input type=submit" + if {0!=[string compare "" $name]} { + cgi_put " name=\"$name\"" + } + cgi_put " value=[cgi_dquote_html $value]" + foreach a $args { + if {[regexp "^onClick=(.*)" $a dummy str]} { + cgi_put " onClick=\"$str\"" + } else { + cgi_put " $a" + } + } + cgi_put "/>" +} + + +proc cgi_reset_button {{value Reset} args} { + cgi_put "<input type=reset value=[cgi_dquote_html $value]" + + foreach a $args { + if {[regexp "^onClick=(.*)" $a dummy str]} { + cgi_put " onClick=\"$str\"" + } else { + cgi_put " $a" + } + } + cgi_put "/>" +} + +proc cgi_radio_button {nameval args} { + regexp "(\[^=]*)=(.*)" $nameval dummy name value + + cgi_put "<input type=radio name=\"$name\" value=[cgi_dquote_html $value]" + + foreach a $args { + if {[regexp "^checked_if_equal=(.*)" $a dummy default]} { + if {0==[string compare $default $value]} { + cgi_put " checked" + } + } elseif {[regexp "^checked=(.*)" $a dummy checked]} { + # test explicitly to avoid forcing user eval + if {$checked} { + cgi_put " checked" + } + } elseif {[regexp "^onClick=(.*)" $a dummy str]} { + cgi_put " onClick=\"$str\"" + } else { + cgi_put " $a" + } + } + cgi_put "/>" +} + +proc cgi_image_button {nameval args} { + regexp "(\[^=]*)=(.*)" $nameval dummy name value + cgi_put "<input type=image" + if {0!=[string compare "" $name]} { + cgi_put " name=\"$name\"" + } + cgi_put " src=\"$value\"" + foreach a $args { + if {[regexp "^onClick=(.*)" $a dummy str]} { + cgi_put " onClick=\"$str\"" + } else { + cgi_put " $a" + } + } + cgi_put "/>" +} + +# map/area implement client-side image maps +proc cgi_map {name cmd} { + cgi_put "<map name=\"$name\">" + _cgi_close_proc_push "cgi_put </map>" + + uplevel 1 $cmd + _cgi_close_proc +} + +proc cgi_area {args} { + cgi_put "<area" + foreach a $args { + if {[regexp "^(coords|shape|href|target|onMouseOut|alt)=(.*)" $a dummy attr str]} { + cgi_put " $attr=\"$str\"" + } else { + cgi_put " $a" + } + } + cgi_put "/>" +} + +################################################## +# checkbox support +################################################## + +proc cgi_checkbox {nameval args} { + regexp "(\[^=]*)(=?)(.*)" $nameval dummy name q value + cgi_put "<input type=checkbox name=\"$name\"" + + if {0!=[string compare "" $value]} { + cgi_put " value=[cgi_dquote_html $value]" + } + + foreach a $args { + if {[regexp "^checked_if_equal=(.*)" $a dummy default]} { + if {0==[string compare $default $value]} { + cgi_put " checked" + } + } elseif {[regexp "^checked=(.*)" $a dummy checked]} { + # test explicitly to avoid forcing user eval + if {$checked} { + cgi_put " checked" + } + } elseif {[regexp "^onClick=(.*)" $a dummy str]} { + cgi_put " onClick=\"$str\"" + } else { + cgi_put " $a" + } + } + cgi_put "/>" +} + +################################################## +# textentry support +################################################## + +proc cgi_text {nameval args} { + regexp "(\[^=]*)(=?)(.*)" $nameval dummy name q value + + cgi_put "<input name=\"$name\"" + + if {$q != "="} { + set value [uplevel 1 set [list $name]] + } + cgi_put " value=[cgi_dquote_html $value]" + + foreach a $args { + if {[regexp "^on(Select|Focus|Blur|Change)=(.*)" $a dummy event str]} { + cgi_put " on$event=\"$str\"" + } else { + cgi_put " $a" + } + } + cgi_put "/>" +} + +################################################## +# textarea support +################################################## + +proc cgi_textarea {nameval args} { + regexp "(\[^=]*)(=?)(.*)" $nameval dummy name q value + + cgi_put "<textarea name=\"$name\"" + foreach a $args { + if {[regexp "^on(Select|Focus|Blur|Change)=(.*)" $a dummy event str]} { + cgi_put " on$event=\"$str\"" + } else { + cgi_put " $a" + } + } + cgi_put ">" + + if {$q != "="} { + set value [uplevel 1 set [list $name]] + } + cgi_put "[cgi_quote_html $value]</textarea>" +} + +################################################## +# file upload support +################################################## + +# for this to work, pass enctype=multipart/form-data to cgi_form +proc cgi_file_button {name args} { + global _cgi + if {[info exists _cgi(formtype)] && ("multipart/form-data" != $_cgi(form,enctype))} { + error "cgi_file_button requires that cgi_form have the argument enctype=multipart/form-data" + } + cgi_put "<input type=file name=\"$name\"[_cgi_list_to_string $args]/>" +} + +# establish a per-file limit for uploads + +proc cgi_file_limit {files chars} { + global _cgi + + set _cgi(file,filelimit) $files + set _cgi(file,charlimit) $chars +} + +################################################## +# select support +################################################## + +proc cgi_select {name args} { + cgi_put "<select name=\"$name\"" + _cgi_close_proc_push "cgi_put </select>" + foreach a [lrange $args 0 [expr [llength $args]-2]] { + if {[regexp "^on(Focus|Blur|Change)=(.*)" $a dummy event str]} { + cgi_put " on$event=\"$str\"" + } else { + if {0==[string compare multiple $a]} { + ;# sanity check + if {![regexp "List$" $name]} { + cgi_puts ">" ;# prevent error from being absorbed + error "When selecting multiple options, select variable \ + must end in \"List\" to allow the value to be \ + recognized as a list when it is processed later." + } + } + cgi_put " $a" + } + } + cgi_put ">" + uplevel 1 [lindex $args end] + _cgi_close_proc +} + +proc cgi_option {o args} { + cgi_put "<option" + set value $o + set selected 0 + foreach a $args { + if {[regexp "^selected_if_equal=(.*)" $a dummy selected_if_equal]} { + } elseif {[regexp "^value=(.*)" $a dummy value]} { + cgi_put " value=[cgi_dquote_html $value]" + } else { + cgi_put " $a" + } + } + if {[info exists selected_if_equal]} { + if {0 == [string compare $selected_if_equal $value]} { + cgi_put " selected" + } + } + cgi_puts ">[cgi_quote_html $o]</option>" +} + +################################################## +# plug-in support +################################################## + +proc cgi_embed {src wh args} { + regexp (.*)x(.*) $wh dummy width height + cgi_put "<embed src=[cgi_dquote_html $src] width=\"$width\" height=\"$height\"" + foreach a $args { + if {[regexp "^palette=(.*)" $a dummy str]} { + cgi_put " palette=\"$str\"" + } elseif {[regexp -- "-quote" $a]} { + set quote 1 + } else { + if {[info exists quote]} { + regexp "(\[^=]*)=(.*)" $a dummy var val + cgi_put " var=[cgi_dquote_html $var]" + } else { + cgi_put " $a" + } + } + } + cgi_put "/>" +} + +################################################## +# mail support +################################################## + +# mail to/from the service itself +proc cgi_mail_addr {args} { + global _cgi + + if {[llength $args]} { + set _cgi(email) [lindex $args 0] + } + return $_cgi(email) +} + +proc cgi_mail_start {to} { + global _cgi + + set _cgi(mailfile) [file join $_cgi(tmpdir) cgimail.[pid]] + set _cgi(mailfid) [open $_cgi(mailfile) w+] + set _cgi(mailto) $to + + # mail is actually sent by "nobody". To force bounce messages + # back to us, override the default return-path. + cgi_mail_add "Return-Path: <$_cgi(email)>" + cgi_mail_add "From: [cgi_name] <$_cgi(email)>" + cgi_mail_add "To: $to" +} + +# add another line to outgoing mail +# if no arg, add a blank line +proc cgi_mail_add {{arg {}}} { + global _cgi + + puts $_cgi(mailfid) $arg +} + +# end the outgoing mail and send it +proc cgi_mail_end {} { + global _cgi + + flush $_cgi(mailfid) + + foreach sendmail in $_cgi(sendmail) { + if {[file executable $sendmail]} { + exec $sendmail -t -odb < $_cgi(mailfile) + # Explanation: + # -t means: pick up recipient from body + # -odb means: deliver in background + # note: bogus local address cause sendmail to fail immediately + set sent 1 + } + } + + if {0==[info exists sent]} { + # fallback for sites without sendmail + + if {0==[info exists _cgi(mail_relay)]} { + regexp "@(.*)" $_cgi(mailto) dummy _cgi(mail_relay) + } + + set s [socket $_cgi(mail_relay) 25] + gets $s answer + if {[lindex $answer 0] != 220} {error $answer} + + puts $s "HELO [info host]";flush $s + gets $s answer + if {[lindex $answer 0] != 250} {error $answer} + + puts $s "MAIL FROM:<$_cgi(email)>";flush $s + gets $s answer + if {[lindex $answer 0] != 250} {error $answer} + + puts $s "RCPT TO:<$_cgi(mailto)>";flush $s + gets $s answer + if {[lindex $answer 0] != 250} {error $answer} + + puts $s DATA;flush $s + gets $s answer + if {[lindex $answer 0] != 354} {error $answer} + + seek $_cgi(mailfid) 0 start + puts $s [read $_cgi(mailfid)];flush $s + puts $s .;flush $s + gets $s answer + if {[lindex $answer 0] != 250} {error $answer} + + close $s + } + close $_cgi(mailfid) + file delete -force $_cgi(mailfile) +} + +proc cgi_mail_relay {host} { + global _cgi + + set _cgi(mail_relay) $host +} + +proc cgi_sendmail {path} { + global _cgi + + set _cgi(sendmail) $path +} + +################################################## +# cookie support +################################################## + +# calls to cookie_set look like this: +# cgi_cookie_set user=don domain=nist.gov expires=never +# cgi_cookie_set user=don domain=nist.gov expires=now +# cgi_cookie_set user=don domain=nist.gov expires=...actual date... + +proc cgi_cookie_set {nameval args} { + global _cgi + + if {![info exists _cgi(http_head_in_progress)]} { + error "Cookies must be set from within cgi_http_head." + } + cgi_puts -nonewline "Set-Cookie: [cgi_cookie_encode $nameval];" + + foreach a $args { + if {[regexp "^expires=(.*)" $a dummy expiration]} { + if {0==[string compare $expiration "never"]} { + set expiration "Friday, 11-Jan-2038 23:59:59 GMT" + } elseif {0==[string compare $expiration "now"]} { + set expiration "Friday, 31-Dec-1990 23:59:59 GMT" + } + cgi_puts -nonewline " expires=$expiration;" + } elseif {[regexp "^(domain|path)=(.*)" $a dummy attr str]} { + cgi_puts -nonewline " $attr=[cgi_cookie_encode $str];" + } elseif {[regexp "^secure$" $a]} { + cgi_puts -nonewline " secure;" + } + } + cgi_puts "" +} + +# return list of cookies available for import +proc cgi_cookie_list {} { + global _cgi_cookie + + array names _cgi_cookie +} + +proc cgi_cookie_get {args} { + global _cgi_cookie + + set all 0 + + set flag [lindex $args 0] + if {$flag == "-all"} { + set args [lrange $args 1 end] + set all 1 + } + set name [lindex $args 0] + + if {$all} { + global _cgi_cookie_shadowed + + if {[info exists _cgi_cookie_shadowed($name)]} { + return [concat $_cgi_cookie($name) $_cgi_cookie_shadowed($name)] + } else { + return [concat $_cgi_cookie($name)] + } + } + return $_cgi_cookie($name) +} + +proc cgi_cookie_encode {in} { + regsub -all " " $in "+" in + regsub -all "%" $in "%25" in ;# must preceed other subs that produce % + regsub -all ";" $in "%3B" in + regsub -all "," $in "%2C" in + regsub -all "\n" $in "%0D%0A" in + return $in +} + +################################################## +# table support +################################################## + +proc cgi_table {args} { + cgi_put "<table" + _cgi_close_proc_push "cgi_put </table>" + + if {[llength $args]} { + cgi_put "[_cgi_lrange $args 0 [expr [llength $args]-2]]" + } + cgi_put ">" + uplevel 1 [lindex $args end] + _cgi_close_proc +} + +proc cgi_caption {args} { + cgi_put "<caption" + _cgi_close_proc_push "cgi_put </caption>" + + if {[llength $args]} { + cgi_put "[_cgi_lrange $args 0 [expr [llength $args]-2]]" + } + cgi_put ">" + uplevel 1 [lindex $args end] + _cgi_close_proc +} + +proc cgi_table_row {args} { + cgi_put "<tr" + _cgi_close_proc_push "cgi_put </tr>" + if {[llength $args]} { + cgi_put "[_cgi_lrange $args 0 [expr [llength $args]-2]]" + } + cgi_put ">" + uplevel 1 [lindex $args end] + _cgi_close_proc +} + +# like table_row but without eval +proc cgi_tr {args} { + cgi_put <tr + if {[llength $args] > 1} { + cgi_put "[_cgi_lrange $args 0 [expr [llength $args]-2]]" + } + cgi_put ">" + foreach i [lindex $args end] { + cgi_td $i + } + cgi_put </tr> +} + +proc cgi_table_head {args} { + cgi_put "<th" + _cgi_close_proc_push "cgi_put </th>" + + if {[llength $args]} { + cgi_put "[_cgi_lrange $args 0 [expr [llength $args]-2]]" + } + cgi_put ">" + uplevel 1 [lindex $args end] + _cgi_close_proc +} + +# like table_head but without eval +proc cgi_th {args} { + cgi_put "<th" + + if {[llength $args] > 1} { + cgi_put "[_cgi_lrange $args 0 [expr [llength $args]-2]]" + } + cgi_put ">[lindex $args end]</th>" +} + +proc cgi_table_data {args} { + cgi_put "<td" + _cgi_close_proc_push "cgi_put </td>" + + if {[llength $args]} { + cgi_put "[_cgi_lrange $args 0 [expr [llength $args]-2]]" + } + cgi_put ">" + uplevel 1 [lindex $args end] + _cgi_close_proc +} + +# like table_data but without eval +proc cgi_td {args} { + cgi_put "<td" + + if {[llength $args] > 1} { + cgi_put "[_cgi_lrange $args 0 [expr [llength $args]-2]]" + } + cgi_put ">[lindex $args end]</td>" +} + +################################################## +# stylesheets - not yet documented +################################################## + +proc cgi_stylesheet {href} { + cgi_puts "<link rel=stylesheet href=\"$href\" type=\"text/css\"/>" +} + +proc cgi_span {args} { + set buf "<span" + foreach a [lrange $args 0 [expr [llength $args]-2]] { + if {[regexp "style=(.*)" $a dummy str]} { + append buf " style=\"$str\"" + } elseif {[regexp "class=(.*)" $a dummy str]} { + append buf " class=\"$str\"" + } else { + append buf " $a" + } + } + return "$buf>[lindex $args end]</span>" +} + +################################################## +# frames +################################################## + +proc cgi_frameset {args} { + cgi_head ;# force it out, just in case none + + cgi_put "<frameset" + _cgi_close_proc_push "cgi_puts </frameset>" + + foreach a [lrange $args 0 [expr [llength $args]-2]] { + if {[regexp "^(rows|cols|onUnload|onLoad|onBlur)=(.*)" $a dummy attr str]} { + cgi_put " $attr=\"$str\"" + } else { + cgi_put " $a" + } + } + cgi_puts ">" + uplevel 1 [lindex $args end] + _cgi_close_proc +} + +proc cgi_frame {namesrc args} { + cgi_put "<frame" + + regexp "(\[^=]*)(=?)(.*)" $namesrc dummy name q src + + if {$name != ""} { + cgi_put " name=\"$name\"" + } + + if {$src != ""} { + cgi_put " src=\"$src\"" + } + + foreach a $args { + if {[regexp "^(marginwidth|marginheight|scrolling|onFocus)=(.*)" $a dummy attr str]} { + cgi_put " $attr=\"$str\"" + } else { + cgi_put " $a" + } + } + cgi_puts "/>" +} + +proc cgi_noframes {args} { + cgi_puts "<noframes>" + _cgi_close_proc_push "cgi_puts </noframes>" + uplevel 1 [lindex $args end] + _cgi_close_proc +} + +################################################## +# admin support +################################################## + +# mail address of the administrator +proc cgi_admin_mail_addr {args} { + global _cgi + + if {[llength $args]} { + set _cgi(admin_email) [lindex $args 0] + } + return $_cgi(admin_email) +} + +################################################## +# if possible, make each cmd available without cgi_ prefix +################################################## + +if {[info tclversion] >= 7.5} { + foreach _cgi(old) [info procs cgi_*] { + regexp "^cgi_(.*)" $_cgi(old) _cgi(dummy) _cgi(new) + if {[llength [info commands $_cgi(new)]]} continue + interp alias {} $_cgi(new) {} $_cgi(old) + } +} else { + foreach _cgi(old) [info procs cgi_*] { + regexp "^cgi_(.*)" $_cgi(old) _cgi(dummy) _cgi(new) + if {[llength [info commands $_cgi(new)]]} continue + proc $_cgi(new) {args} "uplevel 1 $_cgi(old) \$args" + } +} + +################################################## +# internal utilities +################################################## + +# undo Tcl's quoting due to list protection +# This leaves a space at the beginning if the string is non-null +# but this is always desirable in the HTML context in which it is called +# and the resulting HTML looks more readable. +# (It makes the Tcl callers a little less readable - however, there aren't +# more than a handful and they're all right here, so we'll live with it.) +proc _cgi_list_to_string {list} { + set string "" + foreach l $list { + append string " $l" + } + # remove first space if possible + # regexp "^ ?(.*)" $string dummy string + return $string +} + +# do lrange but return as string +# needed for stuff like: cgi_puts "[_cgi_lrange $args ...] +# Like _cgi_list_to_string, also returns string with initial blank if non-null +proc _cgi_lrange {list i1 i2} { + _cgi_list_to_string [lrange $list $i1 $i2] +} + +################################################## +# temporary file procedures +################################################## + +# set appropriate temporary file modes +proc cgi_tmpfile_permissions {{mode ""}} { + global _cgi + + if {[string length $mode]} { + set _cgi(tmpperms) $mode + } + + return $_cgi(tmpperms) +} + +################################################## +# user-defined procedures +################################################## + +# User-defined procedure called immediately after <body> +# Good mechanism for controlling things such as if all of your pages +# start with the same graphic or other boilerplate. +proc app_body_start {} {} + +# User-defined procedure called just before </body> +# Good place to generate signature lines, last-updated-by, etc. +proc app_body_end {} {} + +proc cgi_puts {args} { + eval puts $args +} + +# User-defined procedure to generate DOCTYPE declaration +proc cgi_doctype {} {} + +################################################## +# do some initialization +################################################## + +# cgi_init initializes to a known state. + +proc cgi_init {} { + global _cgi + unset _cgi + + # set explicitly for speed + set _cgi(debug) -off + set _cgi(buffer_nl) "\n" + + cgi_name "" + cgi_root "" + cgi_body_args "" + cgi_file_limit 10 100000000 + + if {[info tclversion] >= 8.1} { + # set initial urlencoding + if { [lsearch -exact [encoding names] "utf-8"] != -1} { + cgi_urlencoding "utf-8" + } else { + cgi_urlencoding [encoding system] + } + } + + # email addr of person responsible for this service + cgi_admin_mail_addr "root" ;# you should override this! + + # most services won't have an actual email addr + cgi_mail_addr "CGI script - do not reply" +} +cgi_init + +# deduce tmp directory +switch $tcl_platform(platform) { + unix { + set _cgi(tmpdir) /tmp + set _cgi(tmpperms) 0644 + set _cgi(sendmail) [list /usr/lib/sendmail /usr/sbin/sendmail] + } macintosh { + set _cgi(tmpdir) [pwd] + set _cgi(tmpperms) {} + set _cgi(sendmail) {} + } default { + set _cgi(tmpdir) [pwd] + catch {set _cgi(tmpdir) $env(TMP)} + catch {set _cgi(tmpdir) $env(TEMP)} + set _cgi(tmpperms) {} + set _cgi(sendmail) {} + } +} + +# regexp for matching attr=val +set _cgi(attr,regexp) "^(\[^=]*)=(\[^\"].*)" + +package provide cgi @CGI_VERSION_FULL@ diff --git a/web/src/cgi.tcl-1.10/cgi.tcl.man b/web/src/cgi.tcl-1.10/cgi.tcl.man new file mode 100644 index 00000000..c121800b --- /dev/null +++ b/web/src/cgi.tcl-1.10/cgi.tcl.man @@ -0,0 +1,36 @@ +.TH CGI.TCL 3 "12 December 1995" +.SH NAME +cgi.tcl \- procedures for CGI scripting in Tcl +.SH DESCRIPTION + +These routines implement the code described in the paper "Writing CGI +scripts in Tcl" which appeared in the Tcl '96 conference. + +This man page is really just a placeholder. See the README for more +info. + +.SH SYNOPSIS +.nf + +source cgi.tcl + +more to come... + +.fi +No attempt is made to explain all aspects of the code. The paper is +the right way to get started. After that, read the code \- the code +really is quite straightforward. Feel free to make changes to it. +Experiment. No claims of completeness are made. (In fact, I can +assure you that there are missing pieces - there are things in CGI +that I find utterly useless so I didn't bother to support them.) + +More to come... + +.SH SEE ALSO +.SH AUTHOR +Don Libes, libes@nist.gov, National Institute of Standards and Technology +.SH ACKNOWLEDGEMENTS +Design and implementation of the this software was paid for by the +U.S. government and is therefore in the public domain. However the +author and NIST would like credit if this program and documentation or +portions of them are used. diff --git a/web/src/cgi.tcl-1.10/configure b/web/src/cgi.tcl-1.10/configure new file mode 100755 index 00000000..1c167432 --- /dev/null +++ b/web/src/cgi.tcl-1.10/configure @@ -0,0 +1,2291 @@ +#! /bin/sh +# Guess values for system-dependent variables and create Makefiles. +# Generated by GNU Autoconf 2.59. +# +# Copyright (C) 2003 Free Software Foundation, Inc. +# This configure script is free software; the Free Software Foundation +# gives unlimited permission to copy, distribute and modify it. +## --------------------- ## +## M4sh Initialization. ## +## --------------------- ## + +# Be Bourne compatible +if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then + emulate sh + NULLCMD=: + # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which + # is contrary to our usage. Disable this feature. + alias -g '${1+"$@"}'='"$@"' +elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then + set -o posix +fi +DUALCASE=1; export DUALCASE # for MKS sh + +# Support unset when possible. +if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then + as_unset=unset +else + as_unset=false +fi + + +# Work around bugs in pre-3.0 UWIN ksh. +$as_unset ENV MAIL MAILPATH +PS1='$ ' +PS2='> ' +PS4='+ ' + +# NLS nuisances. +for as_var in \ + LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \ + LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \ + LC_TELEPHONE LC_TIME +do + if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then + eval $as_var=C; export $as_var + else + $as_unset $as_var + fi +done + +# Required to use basename. +if expr a : '\(a\)' >/dev/null 2>&1; then + as_expr=expr +else + as_expr=false +fi + +if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then + as_basename=basename +else + as_basename=false +fi + + +# Name of the executable. +as_me=`$as_basename "$0" || +$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ + X"$0" : 'X\(//\)$' \| \ + X"$0" : 'X\(/\)$' \| \ + . : '\(.\)' 2>/dev/null || +echo X/"$0" | + sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; } + /^X\/\(\/\/\)$/{ s//\1/; q; } + /^X\/\(\/\).*/{ s//\1/; q; } + s/.*/./; q'` + + +# PATH needs CR, and LINENO needs CR and PATH. +# Avoid depending upon Character Ranges. +as_cr_letters='abcdefghijklmnopqrstuvwxyz' +as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' +as_cr_Letters=$as_cr_letters$as_cr_LETTERS +as_cr_digits='0123456789' +as_cr_alnum=$as_cr_Letters$as_cr_digits + +# The user is always right. +if test "${PATH_SEPARATOR+set}" != set; then + echo "#! /bin/sh" >conf$$.sh + echo "exit 0" >>conf$$.sh + chmod +x conf$$.sh + if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then + PATH_SEPARATOR=';' + else + PATH_SEPARATOR=: + fi + rm -f conf$$.sh +fi + + + as_lineno_1=$LINENO + as_lineno_2=$LINENO + as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` + test "x$as_lineno_1" != "x$as_lineno_2" && + test "x$as_lineno_3" = "x$as_lineno_2" || { + # Find who we are. Look in the path if we contain no path at all + # relative or not. + case $0 in + *[\\/]* ) as_myself=$0 ;; + *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break +done + + ;; + esac + # We did not find ourselves, most probably we were run as `sh COMMAND' + # in which case we are not to be found in the path. + if test "x$as_myself" = x; then + as_myself=$0 + fi + if test ! -f "$as_myself"; then + { echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2 + { (exit 1); exit 1; }; } + fi + case $CONFIG_SHELL in + '') + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for as_base in sh bash ksh sh5; do + case $as_dir in + /*) + if ("$as_dir/$as_base" -c ' + as_lineno_1=$LINENO + as_lineno_2=$LINENO + as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` + test "x$as_lineno_1" != "x$as_lineno_2" && + test "x$as_lineno_3" = "x$as_lineno_2" ') 2>/dev/null; then + $as_unset BASH_ENV || test "${BASH_ENV+set}" != set || { BASH_ENV=; export BASH_ENV; } + $as_unset ENV || test "${ENV+set}" != set || { ENV=; export ENV; } + CONFIG_SHELL=$as_dir/$as_base + export CONFIG_SHELL + exec "$CONFIG_SHELL" "$0" ${1+"$@"} + fi;; + esac + done +done +;; + esac + + # Create $as_me.lineno as a copy of $as_myself, but with $LINENO + # uniformly replaced by the line number. The first 'sed' inserts a + # line-number line before each line; the second 'sed' does the real + # work. The second script uses 'N' to pair each line-number line + # with the numbered line, and appends trailing '-' during + # substitution so that $LINENO is not a special case at line end. + # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the + # second 'sed' script. Blame Lee E. McMahon for sed's syntax. :-) + sed '=' <$as_myself | + sed ' + N + s,$,-, + : loop + s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3, + t loop + s,-$,, + s,^['$as_cr_digits']*\n,, + ' >$as_me.lineno && + chmod +x $as_me.lineno || + { echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2 + { (exit 1); exit 1; }; } + + # Don't try to exec as it changes $[0], causing all sort of problems + # (the dirname of $[0] is not the place where we might find the + # original and so on. Autoconf is especially sensible to this). + . ./$as_me.lineno + # Exit status is that of the last command. + exit +} + + +case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in + *c*,-n*) ECHO_N= ECHO_C=' +' ECHO_T=' ' ;; + *c*,* ) ECHO_N=-n ECHO_C= ECHO_T= ;; + *) ECHO_N= ECHO_C='\c' ECHO_T= ;; +esac + +if expr a : '\(a\)' >/dev/null 2>&1; then + as_expr=expr +else + as_expr=false +fi + +rm -f conf$$ conf$$.exe conf$$.file +echo >conf$$.file +if ln -s conf$$.file conf$$ 2>/dev/null; then + # We could just check for DJGPP; but this test a) works b) is more generic + # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04). + if test -f conf$$.exe; then + # Don't use ln at all; we don't have any links + as_ln_s='cp -p' + else + as_ln_s='ln -s' + fi +elif ln conf$$.file conf$$ 2>/dev/null; then + as_ln_s=ln +else + as_ln_s='cp -p' +fi +rm -f conf$$ conf$$.exe conf$$.file + +if mkdir -p . 2>/dev/null; then + as_mkdir_p=: +else + test -d ./-p && rmdir ./-p + as_mkdir_p=false +fi + +as_executable_p="test -f" + +# Sed expression to map a string onto a valid CPP name. +as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" + +# Sed expression to map a string onto a valid variable name. +as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" + + +# IFS +# We need space, tab and new line, in precisely that order. +as_nl=' +' +IFS=" $as_nl" + +# CDPATH. +$as_unset CDPATH + + +# Name of the host. +# hostname on some systems (SVR3.2, Linux) returns a bogus exit status, +# so uname gets run too. +ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q` + +exec 6>&1 + +# +# Initializations. +# +ac_default_prefix=/usr/local +ac_config_libobj_dir=. +cross_compiling=no +subdirs= +MFLAGS= +MAKEFLAGS= +SHELL=${CONFIG_SHELL-/bin/sh} + +# Maximum number of lines to put in a shell here document. +# This variable seems obsolete. It should probably be removed, and +# only ac_max_sed_lines should be used. +: ${ac_max_here_lines=38} + +# Identity of this package. +PACKAGE_NAME= +PACKAGE_TARNAME= +PACKAGE_VERSION= +PACKAGE_STRING= +PACKAGE_BUGREPORT= + +ac_unique_file="Makefile.in" +ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS INSTALL_PROGRAM INSTALL_SCRIPT INSTALL_DATA CGI_MAJOR_VERSION CGI_MINOR_VERSION CGI_MICRO_VERSION CGI_VERSION_FULL CGI_VERSION CGI_LIB_FILE CGI_LIB_FILES CGI_TCL_EXECUTABLE LIBOBJS LTLIBOBJS' +ac_subst_files='' + +# Initialize some variables set by options. +ac_init_help= +ac_init_version=false +# The variables have the same names as the options, with +# dashes changed to underlines. +cache_file=/dev/null +exec_prefix=NONE +no_create= +no_recursion= +prefix=NONE +program_prefix=NONE +program_suffix=NONE +program_transform_name=s,x,x, +silent= +site= +srcdir= +verbose= +x_includes=NONE +x_libraries=NONE + +# Installation directory options. +# These are left unexpanded so users can "make install exec_prefix=/foo" +# and all the variables that are supposed to be based on exec_prefix +# by default will actually change. +# Use braces instead of parens because sh, perl, etc. also accept them. +bindir='${exec_prefix}/bin' +sbindir='${exec_prefix}/sbin' +libexecdir='${exec_prefix}/libexec' +datadir='${prefix}/share' +sysconfdir='${prefix}/etc' +sharedstatedir='${prefix}/com' +localstatedir='${prefix}/var' +libdir='${exec_prefix}/lib' +includedir='${prefix}/include' +oldincludedir='/usr/include' +infodir='${prefix}/info' +mandir='${prefix}/man' + +ac_prev= +for ac_option +do + # If the previous option needs an argument, assign it. + if test -n "$ac_prev"; then + eval "$ac_prev=\$ac_option" + ac_prev= + continue + fi + + ac_optarg=`expr "x$ac_option" : 'x[^=]*=\(.*\)'` + + # Accept the important Cygnus configure options, so we can diagnose typos. + + case $ac_option in + + -bindir | --bindir | --bindi | --bind | --bin | --bi) + ac_prev=bindir ;; + -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*) + bindir=$ac_optarg ;; + + -build | --build | --buil | --bui | --bu) + ac_prev=build_alias ;; + -build=* | --build=* | --buil=* | --bui=* | --bu=*) + build_alias=$ac_optarg ;; + + -cache-file | --cache-file | --cache-fil | --cache-fi \ + | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c) + ac_prev=cache_file ;; + -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \ + | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*) + cache_file=$ac_optarg ;; + + --config-cache | -C) + cache_file=config.cache ;; + + -datadir | --datadir | --datadi | --datad | --data | --dat | --da) + ac_prev=datadir ;; + -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \ + | --da=*) + datadir=$ac_optarg ;; + + -disable-* | --disable-*) + ac_feature=`expr "x$ac_option" : 'x-*disable-\(.*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null && + { echo "$as_me: error: invalid feature name: $ac_feature" >&2 + { (exit 1); exit 1; }; } + ac_feature=`echo $ac_feature | sed 's/-/_/g'` + eval "enable_$ac_feature=no" ;; + + -enable-* | --enable-*) + ac_feature=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null && + { echo "$as_me: error: invalid feature name: $ac_feature" >&2 + { (exit 1); exit 1; }; } + ac_feature=`echo $ac_feature | sed 's/-/_/g'` + case $ac_option in + *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;; + *) ac_optarg=yes ;; + esac + eval "enable_$ac_feature='$ac_optarg'" ;; + + -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \ + | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \ + | --exec | --exe | --ex) + ac_prev=exec_prefix ;; + -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \ + | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \ + | --exec=* | --exe=* | --ex=*) + exec_prefix=$ac_optarg ;; + + -gas | --gas | --ga | --g) + # Obsolete; use --with-gas. + with_gas=yes ;; + + -help | --help | --hel | --he | -h) + ac_init_help=long ;; + -help=r* | --help=r* | --hel=r* | --he=r* | -hr*) + ac_init_help=recursive ;; + -help=s* | --help=s* | --hel=s* | --he=s* | -hs*) + ac_init_help=short ;; + + -host | --host | --hos | --ho) + ac_prev=host_alias ;; + -host=* | --host=* | --hos=* | --ho=*) + host_alias=$ac_optarg ;; + + -includedir | --includedir | --includedi | --included | --include \ + | --includ | --inclu | --incl | --inc) + ac_prev=includedir ;; + -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \ + | --includ=* | --inclu=* | --incl=* | --inc=*) + includedir=$ac_optarg ;; + + -infodir | --infodir | --infodi | --infod | --info | --inf) + ac_prev=infodir ;; + -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*) + infodir=$ac_optarg ;; + + -libdir | --libdir | --libdi | --libd) + ac_prev=libdir ;; + -libdir=* | --libdir=* | --libdi=* | --libd=*) + libdir=$ac_optarg ;; + + -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \ + | --libexe | --libex | --libe) + ac_prev=libexecdir ;; + -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \ + | --libexe=* | --libex=* | --libe=*) + libexecdir=$ac_optarg ;; + + -localstatedir | --localstatedir | --localstatedi | --localstated \ + | --localstate | --localstat | --localsta | --localst \ + | --locals | --local | --loca | --loc | --lo) + ac_prev=localstatedir ;; + -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ + | --localstate=* | --localstat=* | --localsta=* | --localst=* \ + | --locals=* | --local=* | --loca=* | --loc=* | --lo=*) + localstatedir=$ac_optarg ;; + + -mandir | --mandir | --mandi | --mand | --man | --ma | --m) + ac_prev=mandir ;; + -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*) + mandir=$ac_optarg ;; + + -nfp | --nfp | --nf) + # Obsolete; use --without-fp. + with_fp=no ;; + + -no-create | --no-create | --no-creat | --no-crea | --no-cre \ + | --no-cr | --no-c | -n) + no_create=yes ;; + + -no-recursion | --no-recursion | --no-recursio | --no-recursi \ + | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) + no_recursion=yes ;; + + -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \ + | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \ + | --oldin | --oldi | --old | --ol | --o) + ac_prev=oldincludedir ;; + -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \ + | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \ + | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*) + oldincludedir=$ac_optarg ;; + + -prefix | --prefix | --prefi | --pref | --pre | --pr | --p) + ac_prev=prefix ;; + -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*) + prefix=$ac_optarg ;; + + -program-prefix | --program-prefix | --program-prefi | --program-pref \ + | --program-pre | --program-pr | --program-p) + ac_prev=program_prefix ;; + -program-prefix=* | --program-prefix=* | --program-prefi=* \ + | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*) + program_prefix=$ac_optarg ;; + + -program-suffix | --program-suffix | --program-suffi | --program-suff \ + | --program-suf | --program-su | --program-s) + ac_prev=program_suffix ;; + -program-suffix=* | --program-suffix=* | --program-suffi=* \ + | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*) + program_suffix=$ac_optarg ;; + + -program-transform-name | --program-transform-name \ + | --program-transform-nam | --program-transform-na \ + | --program-transform-n | --program-transform- \ + | --program-transform | --program-transfor \ + | --program-transfo | --program-transf \ + | --program-trans | --program-tran \ + | --progr-tra | --program-tr | --program-t) + ac_prev=program_transform_name ;; + -program-transform-name=* | --program-transform-name=* \ + | --program-transform-nam=* | --program-transform-na=* \ + | --program-transform-n=* | --program-transform-=* \ + | --program-transform=* | --program-transfor=* \ + | --program-transfo=* | --program-transf=* \ + | --program-trans=* | --program-tran=* \ + | --progr-tra=* | --program-tr=* | --program-t=*) + program_transform_name=$ac_optarg ;; + + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil) + silent=yes ;; + + -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) + ac_prev=sbindir ;; + -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ + | --sbi=* | --sb=*) + sbindir=$ac_optarg ;; + + -sharedstatedir | --sharedstatedir | --sharedstatedi \ + | --sharedstated | --sharedstate | --sharedstat | --sharedsta \ + | --sharedst | --shareds | --shared | --share | --shar \ + | --sha | --sh) + ac_prev=sharedstatedir ;; + -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \ + | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \ + | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \ + | --sha=* | --sh=*) + sharedstatedir=$ac_optarg ;; + + -site | --site | --sit) + ac_prev=site ;; + -site=* | --site=* | --sit=*) + site=$ac_optarg ;; + + -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) + ac_prev=srcdir ;; + -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) + srcdir=$ac_optarg ;; + + -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \ + | --syscon | --sysco | --sysc | --sys | --sy) + ac_prev=sysconfdir ;; + -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \ + | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*) + sysconfdir=$ac_optarg ;; + + -target | --target | --targe | --targ | --tar | --ta | --t) + ac_prev=target_alias ;; + -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*) + target_alias=$ac_optarg ;; + + -v | -verbose | --verbose | --verbos | --verbo | --verb) + verbose=yes ;; + + -version | --version | --versio | --versi | --vers | -V) + ac_init_version=: ;; + + -with-* | --with-*) + ac_package=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null && + { echo "$as_me: error: invalid package name: $ac_package" >&2 + { (exit 1); exit 1; }; } + ac_package=`echo $ac_package| sed 's/-/_/g'` + case $ac_option in + *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;; + *) ac_optarg=yes ;; + esac + eval "with_$ac_package='$ac_optarg'" ;; + + -without-* | --without-*) + ac_package=`expr "x$ac_option" : 'x-*without-\(.*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null && + { echo "$as_me: error: invalid package name: $ac_package" >&2 + { (exit 1); exit 1; }; } + ac_package=`echo $ac_package | sed 's/-/_/g'` + eval "with_$ac_package=no" ;; + + --x) + # Obsolete; use --with-x. + with_x=yes ;; + + -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \ + | --x-incl | --x-inc | --x-in | --x-i) + ac_prev=x_includes ;; + -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \ + | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*) + x_includes=$ac_optarg ;; + + -x-libraries | --x-libraries | --x-librarie | --x-librari \ + | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l) + ac_prev=x_libraries ;; + -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \ + | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) + x_libraries=$ac_optarg ;; + + -*) { echo "$as_me: error: unrecognized option: $ac_option +Try \`$0 --help' for more information." >&2 + { (exit 1); exit 1; }; } + ;; + + *=*) + ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='` + # Reject names that are not valid shell variable names. + expr "x$ac_envvar" : ".*[^_$as_cr_alnum]" >/dev/null && + { echo "$as_me: error: invalid variable name: $ac_envvar" >&2 + { (exit 1); exit 1; }; } + ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` + eval "$ac_envvar='$ac_optarg'" + export $ac_envvar ;; + + *) + # FIXME: should be removed in autoconf 3.0. + echo "$as_me: WARNING: you should use --build, --host, --target" >&2 + expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null && + echo "$as_me: WARNING: invalid host type: $ac_option" >&2 + : ${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option} + ;; + + esac +done + +if test -n "$ac_prev"; then + ac_option=--`echo $ac_prev | sed 's/_/-/g'` + { echo "$as_me: error: missing argument to $ac_option" >&2 + { (exit 1); exit 1; }; } +fi + +# Be sure to have absolute paths. +for ac_var in exec_prefix prefix +do + eval ac_val=$`echo $ac_var` + case $ac_val in + [\\/$]* | ?:[\\/]* | NONE | '' ) ;; + *) { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2 + { (exit 1); exit 1; }; };; + esac +done + +# Be sure to have absolute paths. +for ac_var in bindir sbindir libexecdir datadir sysconfdir sharedstatedir \ + localstatedir libdir includedir oldincludedir infodir mandir +do + eval ac_val=$`echo $ac_var` + case $ac_val in + [\\/$]* | ?:[\\/]* ) ;; + *) { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2 + { (exit 1); exit 1; }; };; + esac +done + +# There might be people who depend on the old broken behavior: `$host' +# used to hold the argument of --host etc. +# FIXME: To remove some day. +build=$build_alias +host=$host_alias +target=$target_alias + +# FIXME: To remove some day. +if test "x$host_alias" != x; then + if test "x$build_alias" = x; then + cross_compiling=maybe + echo "$as_me: WARNING: If you wanted to set the --build type, don't use --host. + If a cross compiler is detected then cross compile mode will be used." >&2 + elif test "x$build_alias" != "x$host_alias"; then + cross_compiling=yes + fi +fi + +ac_tool_prefix= +test -n "$host_alias" && ac_tool_prefix=$host_alias- + +test "$silent" = yes && exec 6>/dev/null + + +# Find the source files, if location was not specified. +if test -z "$srcdir"; then + ac_srcdir_defaulted=yes + # Try the directory containing this script, then its parent. + ac_confdir=`(dirname "$0") 2>/dev/null || +$as_expr X"$0" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$0" : 'X\(//\)[^/]' \| \ + X"$0" : 'X\(//\)$' \| \ + X"$0" : 'X\(/\)' \| \ + . : '\(.\)' 2>/dev/null || +echo X"$0" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } + /^X\(\/\/\)[^/].*/{ s//\1/; q; } + /^X\(\/\/\)$/{ s//\1/; q; } + /^X\(\/\).*/{ s//\1/; q; } + s/.*/./; q'` + srcdir=$ac_confdir + if test ! -r $srcdir/$ac_unique_file; then + srcdir=.. + fi +else + ac_srcdir_defaulted=no +fi +if test ! -r $srcdir/$ac_unique_file; then + if test "$ac_srcdir_defaulted" = yes; then + { echo "$as_me: error: cannot find sources ($ac_unique_file) in $ac_confdir or .." >&2 + { (exit 1); exit 1; }; } + else + { echo "$as_me: error: cannot find sources ($ac_unique_file) in $srcdir" >&2 + { (exit 1); exit 1; }; } + fi +fi +(cd $srcdir && test -r ./$ac_unique_file) 2>/dev/null || + { echo "$as_me: error: sources are in $srcdir, but \`cd $srcdir' does not work" >&2 + { (exit 1); exit 1; }; } +srcdir=`echo "$srcdir" | sed 's%\([^\\/]\)[\\/]*$%\1%'` +ac_env_build_alias_set=${build_alias+set} +ac_env_build_alias_value=$build_alias +ac_cv_env_build_alias_set=${build_alias+set} +ac_cv_env_build_alias_value=$build_alias +ac_env_host_alias_set=${host_alias+set} +ac_env_host_alias_value=$host_alias +ac_cv_env_host_alias_set=${host_alias+set} +ac_cv_env_host_alias_value=$host_alias +ac_env_target_alias_set=${target_alias+set} +ac_env_target_alias_value=$target_alias +ac_cv_env_target_alias_set=${target_alias+set} +ac_cv_env_target_alias_value=$target_alias + +# +# Report the --help message. +# +if test "$ac_init_help" = "long"; then + # Omit some internal or obsolete options to make the list less imposing. + # This message is too long to be a string in the A/UX 3.1 sh. + cat <<_ACEOF +\`configure' configures this package to adapt to many kinds of systems. + +Usage: $0 [OPTION]... [VAR=VALUE]... + +To assign environment variables (e.g., CC, CFLAGS...), specify them as +VAR=VALUE. See below for descriptions of some of the useful variables. + +Defaults for the options are specified in brackets. + +Configuration: + -h, --help display this help and exit + --help=short display options specific to this package + --help=recursive display the short help of all the included packages + -V, --version display version information and exit + -q, --quiet, --silent do not print \`checking...' messages + --cache-file=FILE cache test results in FILE [disabled] + -C, --config-cache alias for \`--cache-file=config.cache' + -n, --no-create do not create output files + --srcdir=DIR find the sources in DIR [configure dir or \`..'] + +_ACEOF + + cat <<_ACEOF +Installation directories: + --prefix=PREFIX install architecture-independent files in PREFIX + [$ac_default_prefix] + --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX + [PREFIX] + +By default, \`make install' will install all the files in +\`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify +an installation prefix other than \`$ac_default_prefix' using \`--prefix', +for instance \`--prefix=\$HOME'. + +For better control, use the options below. + +Fine tuning of the installation directories: + --bindir=DIR user executables [EPREFIX/bin] + --sbindir=DIR system admin executables [EPREFIX/sbin] + --libexecdir=DIR program executables [EPREFIX/libexec] + --datadir=DIR read-only architecture-independent data [PREFIX/share] + --sysconfdir=DIR read-only single-machine data [PREFIX/etc] + --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] + --localstatedir=DIR modifiable single-machine data [PREFIX/var] + --libdir=DIR object code libraries [EPREFIX/lib] + --includedir=DIR C header files [PREFIX/include] + --oldincludedir=DIR C header files for non-gcc [/usr/include] + --infodir=DIR info documentation [PREFIX/info] + --mandir=DIR man documentation [PREFIX/man] +_ACEOF + + cat <<\_ACEOF +_ACEOF +fi + +if test -n "$ac_init_help"; then + + cat <<\_ACEOF + +_ACEOF +fi + +if test "$ac_init_help" = "recursive"; then + # If there are subdirs, report their specific --help. + ac_popdir=`pwd` + for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue + test -d $ac_dir || continue + ac_builddir=. + +if test "$ac_dir" != .; then + ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` + # A "../" for each directory in $ac_dir_suffix. + ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'` +else + ac_dir_suffix= ac_top_builddir= +fi + +case $srcdir in + .) # No --srcdir option. We are building in place. + ac_srcdir=. + if test -z "$ac_top_builddir"; then + ac_top_srcdir=. + else + ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'` + fi ;; + [\\/]* | ?:[\\/]* ) # Absolute path. + ac_srcdir=$srcdir$ac_dir_suffix; + ac_top_srcdir=$srcdir ;; + *) # Relative path. + ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix + ac_top_srcdir=$ac_top_builddir$srcdir ;; +esac + +# Do not use `cd foo && pwd` to compute absolute paths, because +# the directories may not exist. +case `pwd` in +.) ac_abs_builddir="$ac_dir";; +*) + case "$ac_dir" in + .) ac_abs_builddir=`pwd`;; + [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";; + *) ac_abs_builddir=`pwd`/"$ac_dir";; + esac;; +esac +case $ac_abs_builddir in +.) ac_abs_top_builddir=${ac_top_builddir}.;; +*) + case ${ac_top_builddir}. in + .) ac_abs_top_builddir=$ac_abs_builddir;; + [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;; + *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;; + esac;; +esac +case $ac_abs_builddir in +.) ac_abs_srcdir=$ac_srcdir;; +*) + case $ac_srcdir in + .) ac_abs_srcdir=$ac_abs_builddir;; + [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;; + *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;; + esac;; +esac +case $ac_abs_builddir in +.) ac_abs_top_srcdir=$ac_top_srcdir;; +*) + case $ac_top_srcdir in + .) ac_abs_top_srcdir=$ac_abs_builddir;; + [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;; + *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;; + esac;; +esac + + cd $ac_dir + # Check for guested configure; otherwise get Cygnus style configure. + if test -f $ac_srcdir/configure.gnu; then + echo + $SHELL $ac_srcdir/configure.gnu --help=recursive + elif test -f $ac_srcdir/configure; then + echo + $SHELL $ac_srcdir/configure --help=recursive + elif test -f $ac_srcdir/configure.ac || + test -f $ac_srcdir/configure.in; then + echo + $ac_configure --help + else + echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2 + fi + cd $ac_popdir + done +fi + +test -n "$ac_init_help" && exit 0 +if $ac_init_version; then + cat <<\_ACEOF + +Copyright (C) 2003 Free Software Foundation, Inc. +This configure script is free software; the Free Software Foundation +gives unlimited permission to copy, distribute and modify it. +_ACEOF + exit 0 +fi +exec 5>config.log +cat >&5 <<_ACEOF +This file contains any messages produced by compilers while +running configure, to aid debugging if configure makes a mistake. + +It was created by $as_me, which was +generated by GNU Autoconf 2.59. Invocation command line was + + $ $0 $@ + +_ACEOF +{ +cat <<_ASUNAME +## --------- ## +## Platform. ## +## --------- ## + +hostname = `(hostname || uname -n) 2>/dev/null | sed 1q` +uname -m = `(uname -m) 2>/dev/null || echo unknown` +uname -r = `(uname -r) 2>/dev/null || echo unknown` +uname -s = `(uname -s) 2>/dev/null || echo unknown` +uname -v = `(uname -v) 2>/dev/null || echo unknown` + +/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown` +/bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown` + +/bin/arch = `(/bin/arch) 2>/dev/null || echo unknown` +/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown` +/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown` +hostinfo = `(hostinfo) 2>/dev/null || echo unknown` +/bin/machine = `(/bin/machine) 2>/dev/null || echo unknown` +/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown` +/bin/universe = `(/bin/universe) 2>/dev/null || echo unknown` + +_ASUNAME + +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + echo "PATH: $as_dir" +done + +} >&5 + +cat >&5 <<_ACEOF + + +## ----------- ## +## Core tests. ## +## ----------- ## + +_ACEOF + + +# Keep a trace of the command line. +# Strip out --no-create and --no-recursion so they do not pile up. +# Strip out --silent because we don't want to record it for future runs. +# Also quote any args containing shell meta-characters. +# Make two passes to allow for proper duplicate-argument suppression. +ac_configure_args= +ac_configure_args0= +ac_configure_args1= +ac_sep= +ac_must_keep_next=false +for ac_pass in 1 2 +do + for ac_arg + do + case $ac_arg in + -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;; + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil) + continue ;; + *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*) + ac_arg=`echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; + esac + case $ac_pass in + 1) ac_configure_args0="$ac_configure_args0 '$ac_arg'" ;; + 2) + ac_configure_args1="$ac_configure_args1 '$ac_arg'" + if test $ac_must_keep_next = true; then + ac_must_keep_next=false # Got value, back to normal. + else + case $ac_arg in + *=* | --config-cache | -C | -disable-* | --disable-* \ + | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \ + | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \ + | -with-* | --with-* | -without-* | --without-* | --x) + case "$ac_configure_args0 " in + "$ac_configure_args1"*" '$ac_arg' "* ) continue ;; + esac + ;; + -* ) ac_must_keep_next=true ;; + esac + fi + ac_configure_args="$ac_configure_args$ac_sep'$ac_arg'" + # Get rid of the leading space. + ac_sep=" " + ;; + esac + done +done +$as_unset ac_configure_args0 || test "${ac_configure_args0+set}" != set || { ac_configure_args0=; export ac_configure_args0; } +$as_unset ac_configure_args1 || test "${ac_configure_args1+set}" != set || { ac_configure_args1=; export ac_configure_args1; } + +# When interrupted or exit'd, cleanup temporary files, and complete +# config.log. We remove comments because anyway the quotes in there +# would cause problems or look ugly. +# WARNING: Be sure not to use single quotes in there, as some shells, +# such as our DU 5.0 friend, will then `close' the trap. +trap 'exit_status=$? + # Save into config.log some information that might help in debugging. + { + echo + + cat <<\_ASBOX +## ---------------- ## +## Cache variables. ## +## ---------------- ## +_ASBOX + echo + # The following way of writing the cache mishandles newlines in values, +{ + (set) 2>&1 | + case `(ac_space='"'"' '"'"'; set | grep ac_space) 2>&1` in + *ac_space=\ *) + sed -n \ + "s/'"'"'/'"'"'\\\\'"'"''"'"'/g; + s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='"'"'\\2'"'"'/p" + ;; + *) + sed -n \ + "s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p" + ;; + esac; +} + echo + + cat <<\_ASBOX +## ----------------- ## +## Output variables. ## +## ----------------- ## +_ASBOX + echo + for ac_var in $ac_subst_vars + do + eval ac_val=$`echo $ac_var` + echo "$ac_var='"'"'$ac_val'"'"'" + done | sort + echo + + if test -n "$ac_subst_files"; then + cat <<\_ASBOX +## ------------- ## +## Output files. ## +## ------------- ## +_ASBOX + echo + for ac_var in $ac_subst_files + do + eval ac_val=$`echo $ac_var` + echo "$ac_var='"'"'$ac_val'"'"'" + done | sort + echo + fi + + if test -s confdefs.h; then + cat <<\_ASBOX +## ----------- ## +## confdefs.h. ## +## ----------- ## +_ASBOX + echo + sed "/^$/d" confdefs.h | sort + echo + fi + test "$ac_signal" != 0 && + echo "$as_me: caught signal $ac_signal" + echo "$as_me: exit $exit_status" + } >&5 + rm -f core *.core && + rm -rf conftest* confdefs* conf$$* $ac_clean_files && + exit $exit_status + ' 0 +for ac_signal in 1 2 13 15; do + trap 'ac_signal='$ac_signal'; { (exit 1); exit 1; }' $ac_signal +done +ac_signal=0 + +# confdefs.h avoids OS command line length limits that DEFS can exceed. +rm -rf conftest* confdefs.h +# AIX cpp loses on an empty file, so make sure it contains at least a newline. +echo >confdefs.h + +# Predefined preprocessor variables. + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_NAME "$PACKAGE_NAME" +_ACEOF + + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_TARNAME "$PACKAGE_TARNAME" +_ACEOF + + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_VERSION "$PACKAGE_VERSION" +_ACEOF + + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_STRING "$PACKAGE_STRING" +_ACEOF + + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT" +_ACEOF + + +# Let the site file select an alternate cache file if it wants to. +# Prefer explicitly selected file to automatically selected ones. +if test -z "$CONFIG_SITE"; then + if test "x$prefix" != xNONE; then + CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site" + else + CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site" + fi +fi +for ac_site_file in $CONFIG_SITE; do + if test -r "$ac_site_file"; then + { echo "$as_me:$LINENO: loading site script $ac_site_file" >&5 +echo "$as_me: loading site script $ac_site_file" >&6;} + sed 's/^/| /' "$ac_site_file" >&5 + . "$ac_site_file" + fi +done + +if test -r "$cache_file"; then + # Some versions of bash will fail to source /dev/null (special + # files actually), so we avoid doing that. + if test -f "$cache_file"; then + { echo "$as_me:$LINENO: loading cache $cache_file" >&5 +echo "$as_me: loading cache $cache_file" >&6;} + case $cache_file in + [\\/]* | ?:[\\/]* ) . $cache_file;; + *) . ./$cache_file;; + esac + fi +else + { echo "$as_me:$LINENO: creating cache $cache_file" >&5 +echo "$as_me: creating cache $cache_file" >&6;} + >$cache_file +fi + +# Check that the precious variables saved in the cache have kept the same +# value. +ac_cache_corrupted=false +for ac_var in `(set) 2>&1 | + sed -n 's/^ac_env_\([a-zA-Z_0-9]*\)_set=.*/\1/p'`; do + eval ac_old_set=\$ac_cv_env_${ac_var}_set + eval ac_new_set=\$ac_env_${ac_var}_set + eval ac_old_val="\$ac_cv_env_${ac_var}_value" + eval ac_new_val="\$ac_env_${ac_var}_value" + case $ac_old_set,$ac_new_set in + set,) + { echo "$as_me:$LINENO: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5 +echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;} + ac_cache_corrupted=: ;; + ,set) + { echo "$as_me:$LINENO: error: \`$ac_var' was not set in the previous run" >&5 +echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;} + ac_cache_corrupted=: ;; + ,);; + *) + if test "x$ac_old_val" != "x$ac_new_val"; then + { echo "$as_me:$LINENO: error: \`$ac_var' has changed since the previous run:" >&5 +echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;} + { echo "$as_me:$LINENO: former value: $ac_old_val" >&5 +echo "$as_me: former value: $ac_old_val" >&2;} + { echo "$as_me:$LINENO: current value: $ac_new_val" >&5 +echo "$as_me: current value: $ac_new_val" >&2;} + ac_cache_corrupted=: + fi;; + esac + # Pass precious variables to config.status. + if test "$ac_new_set" = set; then + case $ac_new_val in + *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*) + ac_arg=$ac_var=`echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;; + *) ac_arg=$ac_var=$ac_new_val ;; + esac + case " $ac_configure_args " in + *" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy. + *) ac_configure_args="$ac_configure_args '$ac_arg'" ;; + esac + fi +done +if $ac_cache_corrupted; then + { echo "$as_me:$LINENO: error: changes in the environment can compromise the build" >&5 +echo "$as_me: error: changes in the environment can compromise the build" >&2;} + { { echo "$as_me:$LINENO: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&5 +echo "$as_me: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&2;} + { (exit 1); exit 1; }; } +fi + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + + + + + + + + + + + + + + + + + + +CGI_MAJOR_VERSION=1 +CGI_MINOR_VERSION=10 +CGI_MICRO_VERSION=0 +CGI_VERSION=$CGI_MAJOR_VERSION.$CGI_MINOR_VERSION +CGI_VERSION_FULL=$CGI_VERSION.$CGI_MICRO_VERSION + +# If `configure' is invoked (in)directly via `make', ensure that it +# encounters no `make' conflicts. +# +unset MFLAGS MAKEFLAGS + +# this'll use a BSD compatible install or our included install-sh +ac_aux_dir= +for ac_dir in $srcdir $srcdir/.. $srcdir/../..; do + if test -f $ac_dir/install-sh; then + ac_aux_dir=$ac_dir + ac_install_sh="$ac_aux_dir/install-sh -c" + break + elif test -f $ac_dir/install.sh; then + ac_aux_dir=$ac_dir + ac_install_sh="$ac_aux_dir/install.sh -c" + break + elif test -f $ac_dir/shtool; then + ac_aux_dir=$ac_dir + ac_install_sh="$ac_aux_dir/shtool install -c" + break + fi +done +if test -z "$ac_aux_dir"; then + { { echo "$as_me:$LINENO: error: cannot find install-sh or install.sh in $srcdir $srcdir/.. $srcdir/../.." >&5 +echo "$as_me: error: cannot find install-sh or install.sh in $srcdir $srcdir/.. $srcdir/../.." >&2;} + { (exit 1); exit 1; }; } +fi +ac_config_guess="$SHELL $ac_aux_dir/config.guess" +ac_config_sub="$SHELL $ac_aux_dir/config.sub" +ac_configure="$SHELL $ac_aux_dir/configure" # This should be Cygnus configure. + +# Find a good install program. We prefer a C program (faster), +# so one script is as good as another. But avoid the broken or +# incompatible versions: +# SysV /etc/install, /usr/sbin/install +# SunOS /usr/etc/install +# IRIX /sbin/install +# AIX /bin/install +# AmigaOS /C/install, which installs bootblocks on floppy discs +# AIX 4 /usr/bin/installbsd, which doesn't work without a -g flag +# AFS /usr/afsws/bin/install, which mishandles nonexistent args +# SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff" +# OS/2's system install, which has a completely different semantic +# ./install, which can be erroneously created by make from ./install.sh. +echo "$as_me:$LINENO: checking for a BSD-compatible install" >&5 +echo $ECHO_N "checking for a BSD-compatible install... $ECHO_C" >&6 +if test -z "$INSTALL"; then +if test "${ac_cv_path_install+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + # Account for people who put trailing slashes in PATH elements. +case $as_dir/ in + ./ | .// | /cC/* | \ + /etc/* | /usr/sbin/* | /usr/etc/* | /sbin/* | /usr/afsws/bin/* | \ + ?:\\/os2\\/install\\/* | ?:\\/OS2\\/INSTALL\\/* | \ + /usr/ucb/* ) ;; + *) + # OSF1 and SCO ODT 3.0 have their own names for install. + # Don't use installbsd from OSF since it installs stuff as root + # by default. + for ac_prog in ginstall scoinst install; do + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_prog$ac_exec_ext"; then + if test $ac_prog = install && + grep dspmsg "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then + # AIX install. It has an incompatible calling convention. + : + elif test $ac_prog = install && + grep pwplus "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then + # program-specific install script used by HP pwplus--don't use. + : + else + ac_cv_path_install="$as_dir/$ac_prog$ac_exec_ext -c" + break 3 + fi + fi + done + done + ;; +esac +done + + +fi + if test "${ac_cv_path_install+set}" = set; then + INSTALL=$ac_cv_path_install + else + # As a last resort, use the slow shell script. We don't cache a + # path for INSTALL within a source directory, because that will + # break other packages using the cache if that directory is + # removed, or if the path is relative. + INSTALL=$ac_install_sh + fi +fi +echo "$as_me:$LINENO: result: $INSTALL" >&5 +echo "${ECHO_T}$INSTALL" >&6 + +# Use test -z because SunOS4 sh mishandles braces in ${var-val}. +# It thinks the first close brace ends the variable substitution. +test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}' + +test -z "$INSTALL_SCRIPT" && INSTALL_SCRIPT='${INSTALL}' + +test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644' + + +# Find a usable Tcl executable so that we can run Tcl utilities +# For simplicity, assume Tcl is completely installed. +echo "$as_me:$LINENO: checking for usable Tcl executable" >&5 +echo $ECHO_N "checking for usable Tcl executable... $ECHO_C" >&6 +for i in \ + ${exec_prefix}/bin/tclsh \ + `ls -r ${exec_prefix}/bin/tclsh[8-9]* 2>/dev/null` \ + ${prefix}/bin/tclsh \ + `ls -r ${prefix}/bin/tclsh[8-9]* 2>/dev/null` \ + ${srcdir}/../tcl/unix/tclsh \ + `ls -dr ${srcdir}/../tcl[8-9]*/unix/tclsh 2>/dev/null` \ + /usr/local/bin/tclsh \ + /usr/bin/tclsh ; do + if test -x "$i" ; then + CGI_TCL_EXECUTABLE=$i + break + fi +done +if test "x$CGI_TCL_EXECUTABLE" = "x" ; then + { { echo "$as_me:$LINENO: error: no tcl executable found, cannot install" >&5 +echo "$as_me: error: no tcl executable found, cannot install" >&2;} + { (exit 1); exit 1; }; } +else + echo "$as_me:$LINENO: result: $CGI_TCL_EXECUTABLE" >&5 +echo "${ECHO_T}$CGI_TCL_EXECUTABLE" >&6 +fi + +# +# Set up makefile substitutions +# + + + + + + + + + ac_config_files="$ac_config_files Makefile cgi.tcl version" +cat >confcache <<\_ACEOF +# This file is a shell script that caches the results of configure +# tests run on this system so they can be shared between configure +# scripts and configure runs, see configure's option --config-cache. +# It is not useful on other systems. If it contains results you don't +# want to keep, you may remove or edit it. +# +# config.status only pays attention to the cache file if you give it +# the --recheck option to rerun configure. +# +# `ac_cv_env_foo' variables (set or unset) will be overridden when +# loading this file, other *unset* `ac_cv_foo' will be assigned the +# following values. + +_ACEOF + +# The following way of writing the cache mishandles newlines in values, +# but we know of no workaround that is simple, portable, and efficient. +# So, don't put newlines in cache variables' values. +# Ultrix sh set writes to stderr and can't be redirected directly, +# and sets the high bit in the cache file unless we assign to the vars. +{ + (set) 2>&1 | + case `(ac_space=' '; set | grep ac_space) 2>&1` in + *ac_space=\ *) + # `set' does not quote correctly, so add quotes (double-quote + # substitution turns \\\\ into \\, and sed turns \\ into \). + sed -n \ + "s/'/'\\\\''/g; + s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p" + ;; + *) + # `set' quotes correctly as required by POSIX, so do not add quotes. + sed -n \ + "s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p" + ;; + esac; +} | + sed ' + t clear + : clear + s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/ + t end + /^ac_cv_env/!s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/ + : end' >>confcache +if diff $cache_file confcache >/dev/null 2>&1; then :; else + if test -w $cache_file; then + test "x$cache_file" != "x/dev/null" && echo "updating cache $cache_file" + cat confcache >$cache_file + else + echo "not updating unwritable cache $cache_file" + fi +fi +rm -f confcache + +test "x$prefix" = xNONE && prefix=$ac_default_prefix +# Let make expand exec_prefix. +test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' + +# VPATH may cause trouble with some makes, so we remove $(srcdir), +# ${srcdir} and @srcdir@ from VPATH if srcdir is ".", strip leading and +# trailing colons and then remove the whole line if VPATH becomes empty +# (actually we leave an empty line to preserve line numbers). +if test "x$srcdir" = x.; then + ac_vpsub='/^[ ]*VPATH[ ]*=/{ +s/:*\$(srcdir):*/:/; +s/:*\${srcdir}:*/:/; +s/:*@srcdir@:*/:/; +s/^\([^=]*=[ ]*\):*/\1/; +s/:*$//; +s/^[^=]*=[ ]*$//; +}' +fi + +# Transform confdefs.h into DEFS. +# Protect against shell expansion while executing Makefile rules. +# Protect against Makefile macro expansion. +# +# If the first sed substitution is executed (which looks for macros that +# take arguments), then we branch to the quote section. Otherwise, +# look for a macro that doesn't take arguments. +cat >confdef2opt.sed <<\_ACEOF +t clear +: clear +s,^[ ]*#[ ]*define[ ][ ]*\([^ (][^ (]*([^)]*)\)[ ]*\(.*\),-D\1=\2,g +t quote +s,^[ ]*#[ ]*define[ ][ ]*\([^ ][^ ]*\)[ ]*\(.*\),-D\1=\2,g +t quote +d +: quote +s,[ `~#$^&*(){}\\|;'"<>?],\\&,g +s,\[,\\&,g +s,\],\\&,g +s,\$,$$,g +p +_ACEOF +# We use echo to avoid assuming a particular line-breaking character. +# The extra dot is to prevent the shell from consuming trailing +# line-breaks from the sub-command output. A line-break within +# single-quotes doesn't work because, if this script is created in a +# platform that uses two characters for line-breaks (e.g., DOS), tr +# would break. +ac_LF_and_DOT=`echo; echo .` +DEFS=`sed -n -f confdef2opt.sed confdefs.h | tr "$ac_LF_and_DOT" ' .'` +rm -f confdef2opt.sed + + +ac_libobjs= +ac_ltlibobjs= +for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue + # 1. Remove the extension, and $U if already installed. + ac_i=`echo "$ac_i" | + sed 's/\$U\././;s/\.o$//;s/\.obj$//'` + # 2. Add them. + ac_libobjs="$ac_libobjs $ac_i\$U.$ac_objext" + ac_ltlibobjs="$ac_ltlibobjs $ac_i"'$U.lo' +done +LIBOBJS=$ac_libobjs + +LTLIBOBJS=$ac_ltlibobjs + + + +: ${CONFIG_STATUS=./config.status} +ac_clean_files_save=$ac_clean_files +ac_clean_files="$ac_clean_files $CONFIG_STATUS" +{ echo "$as_me:$LINENO: creating $CONFIG_STATUS" >&5 +echo "$as_me: creating $CONFIG_STATUS" >&6;} +cat >$CONFIG_STATUS <<_ACEOF +#! $SHELL +# Generated by $as_me. +# Run this file to recreate the current configuration. +# Compiler output produced by configure, useful for debugging +# configure, is in config.log if it exists. + +debug=false +ac_cs_recheck=false +ac_cs_silent=false +SHELL=\${CONFIG_SHELL-$SHELL} +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF +## --------------------- ## +## M4sh Initialization. ## +## --------------------- ## + +# Be Bourne compatible +if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then + emulate sh + NULLCMD=: + # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which + # is contrary to our usage. Disable this feature. + alias -g '${1+"$@"}'='"$@"' +elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then + set -o posix +fi +DUALCASE=1; export DUALCASE # for MKS sh + +# Support unset when possible. +if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then + as_unset=unset +else + as_unset=false +fi + + +# Work around bugs in pre-3.0 UWIN ksh. +$as_unset ENV MAIL MAILPATH +PS1='$ ' +PS2='> ' +PS4='+ ' + +# NLS nuisances. +for as_var in \ + LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \ + LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \ + LC_TELEPHONE LC_TIME +do + if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then + eval $as_var=C; export $as_var + else + $as_unset $as_var + fi +done + +# Required to use basename. +if expr a : '\(a\)' >/dev/null 2>&1; then + as_expr=expr +else + as_expr=false +fi + +if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then + as_basename=basename +else + as_basename=false +fi + + +# Name of the executable. +as_me=`$as_basename "$0" || +$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ + X"$0" : 'X\(//\)$' \| \ + X"$0" : 'X\(/\)$' \| \ + . : '\(.\)' 2>/dev/null || +echo X/"$0" | + sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; } + /^X\/\(\/\/\)$/{ s//\1/; q; } + /^X\/\(\/\).*/{ s//\1/; q; } + s/.*/./; q'` + + +# PATH needs CR, and LINENO needs CR and PATH. +# Avoid depending upon Character Ranges. +as_cr_letters='abcdefghijklmnopqrstuvwxyz' +as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' +as_cr_Letters=$as_cr_letters$as_cr_LETTERS +as_cr_digits='0123456789' +as_cr_alnum=$as_cr_Letters$as_cr_digits + +# The user is always right. +if test "${PATH_SEPARATOR+set}" != set; then + echo "#! /bin/sh" >conf$$.sh + echo "exit 0" >>conf$$.sh + chmod +x conf$$.sh + if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then + PATH_SEPARATOR=';' + else + PATH_SEPARATOR=: + fi + rm -f conf$$.sh +fi + + + as_lineno_1=$LINENO + as_lineno_2=$LINENO + as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` + test "x$as_lineno_1" != "x$as_lineno_2" && + test "x$as_lineno_3" = "x$as_lineno_2" || { + # Find who we are. Look in the path if we contain no path at all + # relative or not. + case $0 in + *[\\/]* ) as_myself=$0 ;; + *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break +done + + ;; + esac + # We did not find ourselves, most probably we were run as `sh COMMAND' + # in which case we are not to be found in the path. + if test "x$as_myself" = x; then + as_myself=$0 + fi + if test ! -f "$as_myself"; then + { { echo "$as_me:$LINENO: error: cannot find myself; rerun with an absolute path" >&5 +echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2;} + { (exit 1); exit 1; }; } + fi + case $CONFIG_SHELL in + '') + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for as_base in sh bash ksh sh5; do + case $as_dir in + /*) + if ("$as_dir/$as_base" -c ' + as_lineno_1=$LINENO + as_lineno_2=$LINENO + as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` + test "x$as_lineno_1" != "x$as_lineno_2" && + test "x$as_lineno_3" = "x$as_lineno_2" ') 2>/dev/null; then + $as_unset BASH_ENV || test "${BASH_ENV+set}" != set || { BASH_ENV=; export BASH_ENV; } + $as_unset ENV || test "${ENV+set}" != set || { ENV=; export ENV; } + CONFIG_SHELL=$as_dir/$as_base + export CONFIG_SHELL + exec "$CONFIG_SHELL" "$0" ${1+"$@"} + fi;; + esac + done +done +;; + esac + + # Create $as_me.lineno as a copy of $as_myself, but with $LINENO + # uniformly replaced by the line number. The first 'sed' inserts a + # line-number line before each line; the second 'sed' does the real + # work. The second script uses 'N' to pair each line-number line + # with the numbered line, and appends trailing '-' during + # substitution so that $LINENO is not a special case at line end. + # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the + # second 'sed' script. Blame Lee E. McMahon for sed's syntax. :-) + sed '=' <$as_myself | + sed ' + N + s,$,-, + : loop + s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3, + t loop + s,-$,, + s,^['$as_cr_digits']*\n,, + ' >$as_me.lineno && + chmod +x $as_me.lineno || + { { echo "$as_me:$LINENO: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&5 +echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2;} + { (exit 1); exit 1; }; } + + # Don't try to exec as it changes $[0], causing all sort of problems + # (the dirname of $[0] is not the place where we might find the + # original and so on. Autoconf is especially sensible to this). + . ./$as_me.lineno + # Exit status is that of the last command. + exit +} + + +case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in + *c*,-n*) ECHO_N= ECHO_C=' +' ECHO_T=' ' ;; + *c*,* ) ECHO_N=-n ECHO_C= ECHO_T= ;; + *) ECHO_N= ECHO_C='\c' ECHO_T= ;; +esac + +if expr a : '\(a\)' >/dev/null 2>&1; then + as_expr=expr +else + as_expr=false +fi + +rm -f conf$$ conf$$.exe conf$$.file +echo >conf$$.file +if ln -s conf$$.file conf$$ 2>/dev/null; then + # We could just check for DJGPP; but this test a) works b) is more generic + # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04). + if test -f conf$$.exe; then + # Don't use ln at all; we don't have any links + as_ln_s='cp -p' + else + as_ln_s='ln -s' + fi +elif ln conf$$.file conf$$ 2>/dev/null; then + as_ln_s=ln +else + as_ln_s='cp -p' +fi +rm -f conf$$ conf$$.exe conf$$.file + +if mkdir -p . 2>/dev/null; then + as_mkdir_p=: +else + test -d ./-p && rmdir ./-p + as_mkdir_p=false +fi + +as_executable_p="test -f" + +# Sed expression to map a string onto a valid CPP name. +as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" + +# Sed expression to map a string onto a valid variable name. +as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" + + +# IFS +# We need space, tab and new line, in precisely that order. +as_nl=' +' +IFS=" $as_nl" + +# CDPATH. +$as_unset CDPATH + +exec 6>&1 + +# Open the log real soon, to keep \$[0] and so on meaningful, and to +# report actual input values of CONFIG_FILES etc. instead of their +# values after options handling. Logging --version etc. is OK. +exec 5>>config.log +{ + echo + sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX +## Running $as_me. ## +_ASBOX +} >&5 +cat >&5 <<_CSEOF + +This file was extended by $as_me, which was +generated by GNU Autoconf 2.59. Invocation command line was + + CONFIG_FILES = $CONFIG_FILES + CONFIG_HEADERS = $CONFIG_HEADERS + CONFIG_LINKS = $CONFIG_LINKS + CONFIG_COMMANDS = $CONFIG_COMMANDS + $ $0 $@ + +_CSEOF +echo "on `(hostname || uname -n) 2>/dev/null | sed 1q`" >&5 +echo >&5 +_ACEOF + +# Files that config.status was made for. +if test -n "$ac_config_files"; then + echo "config_files=\"$ac_config_files\"" >>$CONFIG_STATUS +fi + +if test -n "$ac_config_headers"; then + echo "config_headers=\"$ac_config_headers\"" >>$CONFIG_STATUS +fi + +if test -n "$ac_config_links"; then + echo "config_links=\"$ac_config_links\"" >>$CONFIG_STATUS +fi + +if test -n "$ac_config_commands"; then + echo "config_commands=\"$ac_config_commands\"" >>$CONFIG_STATUS +fi + +cat >>$CONFIG_STATUS <<\_ACEOF + +ac_cs_usage="\ +\`$as_me' instantiates files from templates according to the +current configuration. + +Usage: $0 [OPTIONS] [FILE]... + + -h, --help print this help, then exit + -V, --version print version number, then exit + -q, --quiet do not print progress messages + -d, --debug don't remove temporary files + --recheck update $as_me by reconfiguring in the same conditions + --file=FILE[:TEMPLATE] + instantiate the configuration file FILE + +Configuration files: +$config_files + +Report bugs to <bug-autoconf@gnu.org>." +_ACEOF + +cat >>$CONFIG_STATUS <<_ACEOF +ac_cs_version="\\ +config.status +configured by $0, generated by GNU Autoconf 2.59, + with options \\"`echo "$ac_configure_args" | sed 's/[\\""\`\$]/\\\\&/g'`\\" + +Copyright (C) 2003 Free Software Foundation, Inc. +This config.status script is free software; the Free Software Foundation +gives unlimited permission to copy, distribute and modify it." +srcdir=$srcdir +INSTALL="$INSTALL" +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF +# If no file are specified by the user, then we need to provide default +# value. By we need to know if files were specified by the user. +ac_need_defaults=: +while test $# != 0 +do + case $1 in + --*=*) + ac_option=`expr "x$1" : 'x\([^=]*\)='` + ac_optarg=`expr "x$1" : 'x[^=]*=\(.*\)'` + ac_shift=: + ;; + -*) + ac_option=$1 + ac_optarg=$2 + ac_shift=shift + ;; + *) # This is not an option, so the user has probably given explicit + # arguments. + ac_option=$1 + ac_need_defaults=false;; + esac + + case $ac_option in + # Handling of the options. +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF + -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) + ac_cs_recheck=: ;; + --version | --vers* | -V ) + echo "$ac_cs_version"; exit 0 ;; + --he | --h) + # Conflict between --help and --header + { { echo "$as_me:$LINENO: error: ambiguous option: $1 +Try \`$0 --help' for more information." >&5 +echo "$as_me: error: ambiguous option: $1 +Try \`$0 --help' for more information." >&2;} + { (exit 1); exit 1; }; };; + --help | --hel | -h ) + echo "$ac_cs_usage"; exit 0 ;; + --debug | --d* | -d ) + debug=: ;; + --file | --fil | --fi | --f ) + $ac_shift + CONFIG_FILES="$CONFIG_FILES $ac_optarg" + ac_need_defaults=false;; + --header | --heade | --head | --hea ) + $ac_shift + CONFIG_HEADERS="$CONFIG_HEADERS $ac_optarg" + ac_need_defaults=false;; + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil | --si | --s) + ac_cs_silent=: ;; + + # This is an error. + -*) { { echo "$as_me:$LINENO: error: unrecognized option: $1 +Try \`$0 --help' for more information." >&5 +echo "$as_me: error: unrecognized option: $1 +Try \`$0 --help' for more information." >&2;} + { (exit 1); exit 1; }; } ;; + + *) ac_config_targets="$ac_config_targets $1" ;; + + esac + shift +done + +ac_configure_extra_args= + +if $ac_cs_silent; then + exec 6>/dev/null + ac_configure_extra_args="$ac_configure_extra_args --silent" +fi + +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF +if \$ac_cs_recheck; then + echo "running $SHELL $0 " $ac_configure_args \$ac_configure_extra_args " --no-create --no-recursion" >&6 + exec $SHELL $0 $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion +fi + +_ACEOF + + + + + +cat >>$CONFIG_STATUS <<\_ACEOF +for ac_config_target in $ac_config_targets +do + case "$ac_config_target" in + # Handling of arguments. + "Makefile" ) CONFIG_FILES="$CONFIG_FILES Makefile" ;; + "cgi.tcl" ) CONFIG_FILES="$CONFIG_FILES cgi.tcl" ;; + "version" ) CONFIG_FILES="$CONFIG_FILES version" ;; + *) { { echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5 +echo "$as_me: error: invalid argument: $ac_config_target" >&2;} + { (exit 1); exit 1; }; };; + esac +done + +# If the user did not use the arguments to specify the items to instantiate, +# then the envvar interface is used. Set only those that are not. +# We use the long form for the default assignment because of an extremely +# bizarre bug on SunOS 4.1.3. +if $ac_need_defaults; then + test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files +fi + +# Have a temporary directory for convenience. Make it in the build tree +# simply because there is no reason to put it here, and in addition, +# creating and moving files from /tmp can sometimes cause problems. +# Create a temporary directory, and hook for its removal unless debugging. +$debug || +{ + trap 'exit_status=$?; rm -rf $tmp && exit $exit_status' 0 + trap '{ (exit 1); exit 1; }' 1 2 13 15 +} + +# Create a (secure) tmp directory for tmp files. + +{ + tmp=`(umask 077 && mktemp -d -q "./confstatXXXXXX") 2>/dev/null` && + test -n "$tmp" && test -d "$tmp" +} || +{ + tmp=./confstat$$-$RANDOM + (umask 077 && mkdir $tmp) +} || +{ + echo "$me: cannot create a temporary directory in ." >&2 + { (exit 1); exit 1; } +} + +_ACEOF + +cat >>$CONFIG_STATUS <<_ACEOF + +# +# CONFIG_FILES section. +# + +# No need to generate the scripts if there are no CONFIG_FILES. +# This happens for instance when ./config.status config.h +if test -n "\$CONFIG_FILES"; then + # Protect against being on the right side of a sed subst in config.status. + sed 's/,@/@@/; s/@,/@@/; s/,;t t\$/@;t t/; /@;t t\$/s/[\\\\&,]/\\\\&/g; + s/@@/,@/; s/@@/@,/; s/@;t t\$/,;t t/' >\$tmp/subs.sed <<\\CEOF +s,@SHELL@,$SHELL,;t t +s,@PATH_SEPARATOR@,$PATH_SEPARATOR,;t t +s,@PACKAGE_NAME@,$PACKAGE_NAME,;t t +s,@PACKAGE_TARNAME@,$PACKAGE_TARNAME,;t t +s,@PACKAGE_VERSION@,$PACKAGE_VERSION,;t t +s,@PACKAGE_STRING@,$PACKAGE_STRING,;t t +s,@PACKAGE_BUGREPORT@,$PACKAGE_BUGREPORT,;t t +s,@exec_prefix@,$exec_prefix,;t t +s,@prefix@,$prefix,;t t +s,@program_transform_name@,$program_transform_name,;t t +s,@bindir@,$bindir,;t t +s,@sbindir@,$sbindir,;t t +s,@libexecdir@,$libexecdir,;t t +s,@datadir@,$datadir,;t t +s,@sysconfdir@,$sysconfdir,;t t +s,@sharedstatedir@,$sharedstatedir,;t t +s,@localstatedir@,$localstatedir,;t t +s,@libdir@,$libdir,;t t +s,@includedir@,$includedir,;t t +s,@oldincludedir@,$oldincludedir,;t t +s,@infodir@,$infodir,;t t +s,@mandir@,$mandir,;t t +s,@build_alias@,$build_alias,;t t +s,@host_alias@,$host_alias,;t t +s,@target_alias@,$target_alias,;t t +s,@DEFS@,$DEFS,;t t +s,@ECHO_C@,$ECHO_C,;t t +s,@ECHO_N@,$ECHO_N,;t t +s,@ECHO_T@,$ECHO_T,;t t +s,@LIBS@,$LIBS,;t t +s,@INSTALL_PROGRAM@,$INSTALL_PROGRAM,;t t +s,@INSTALL_SCRIPT@,$INSTALL_SCRIPT,;t t +s,@INSTALL_DATA@,$INSTALL_DATA,;t t +s,@CGI_MAJOR_VERSION@,$CGI_MAJOR_VERSION,;t t +s,@CGI_MINOR_VERSION@,$CGI_MINOR_VERSION,;t t +s,@CGI_MICRO_VERSION@,$CGI_MICRO_VERSION,;t t +s,@CGI_VERSION_FULL@,$CGI_VERSION_FULL,;t t +s,@CGI_VERSION@,$CGI_VERSION,;t t +s,@CGI_LIB_FILE@,$CGI_LIB_FILE,;t t +s,@CGI_LIB_FILES@,$CGI_LIB_FILES,;t t +s,@CGI_TCL_EXECUTABLE@,$CGI_TCL_EXECUTABLE,;t t +s,@LIBOBJS@,$LIBOBJS,;t t +s,@LTLIBOBJS@,$LTLIBOBJS,;t t +CEOF + +_ACEOF + + cat >>$CONFIG_STATUS <<\_ACEOF + # Split the substitutions into bite-sized pieces for seds with + # small command number limits, like on Digital OSF/1 and HP-UX. + ac_max_sed_lines=48 + ac_sed_frag=1 # Number of current file. + ac_beg=1 # First line for current file. + ac_end=$ac_max_sed_lines # Line after last line for current file. + ac_more_lines=: + ac_sed_cmds= + while $ac_more_lines; do + if test $ac_beg -gt 1; then + sed "1,${ac_beg}d; ${ac_end}q" $tmp/subs.sed >$tmp/subs.frag + else + sed "${ac_end}q" $tmp/subs.sed >$tmp/subs.frag + fi + if test ! -s $tmp/subs.frag; then + ac_more_lines=false + else + # The purpose of the label and of the branching condition is to + # speed up the sed processing (if there are no `@' at all, there + # is no need to browse any of the substitutions). + # These are the two extra sed commands mentioned above. + (echo ':t + /@[a-zA-Z_][a-zA-Z_0-9]*@/!b' && cat $tmp/subs.frag) >$tmp/subs-$ac_sed_frag.sed + if test -z "$ac_sed_cmds"; then + ac_sed_cmds="sed -f $tmp/subs-$ac_sed_frag.sed" + else + ac_sed_cmds="$ac_sed_cmds | sed -f $tmp/subs-$ac_sed_frag.sed" + fi + ac_sed_frag=`expr $ac_sed_frag + 1` + ac_beg=$ac_end + ac_end=`expr $ac_end + $ac_max_sed_lines` + fi + done + if test -z "$ac_sed_cmds"; then + ac_sed_cmds=cat + fi +fi # test -n "$CONFIG_FILES" + +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF +for ac_file in : $CONFIG_FILES; do test "x$ac_file" = x: && continue + # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in". + case $ac_file in + - | *:- | *:-:* ) # input from stdin + cat >$tmp/stdin + ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'` + ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;; + *:* ) ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'` + ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;; + * ) ac_file_in=$ac_file.in ;; + esac + + # Compute @srcdir@, @top_srcdir@, and @INSTALL@ for subdirectories. + ac_dir=`(dirname "$ac_file") 2>/dev/null || +$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$ac_file" : 'X\(//\)[^/]' \| \ + X"$ac_file" : 'X\(//\)$' \| \ + X"$ac_file" : 'X\(/\)' \| \ + . : '\(.\)' 2>/dev/null || +echo X"$ac_file" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } + /^X\(\/\/\)[^/].*/{ s//\1/; q; } + /^X\(\/\/\)$/{ s//\1/; q; } + /^X\(\/\).*/{ s//\1/; q; } + s/.*/./; q'` + { if $as_mkdir_p; then + mkdir -p "$ac_dir" + else + as_dir="$ac_dir" + as_dirs= + while test ! -d "$as_dir"; do + as_dirs="$as_dir $as_dirs" + as_dir=`(dirname "$as_dir") 2>/dev/null || +$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$as_dir" : 'X\(//\)[^/]' \| \ + X"$as_dir" : 'X\(//\)$' \| \ + X"$as_dir" : 'X\(/\)' \| \ + . : '\(.\)' 2>/dev/null || +echo X"$as_dir" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } + /^X\(\/\/\)[^/].*/{ s//\1/; q; } + /^X\(\/\/\)$/{ s//\1/; q; } + /^X\(\/\).*/{ s//\1/; q; } + s/.*/./; q'` + done + test ! -n "$as_dirs" || mkdir $as_dirs + fi || { { echo "$as_me:$LINENO: error: cannot create directory \"$ac_dir\"" >&5 +echo "$as_me: error: cannot create directory \"$ac_dir\"" >&2;} + { (exit 1); exit 1; }; }; } + + ac_builddir=. + +if test "$ac_dir" != .; then + ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` + # A "../" for each directory in $ac_dir_suffix. + ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'` +else + ac_dir_suffix= ac_top_builddir= +fi + +case $srcdir in + .) # No --srcdir option. We are building in place. + ac_srcdir=. + if test -z "$ac_top_builddir"; then + ac_top_srcdir=. + else + ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'` + fi ;; + [\\/]* | ?:[\\/]* ) # Absolute path. + ac_srcdir=$srcdir$ac_dir_suffix; + ac_top_srcdir=$srcdir ;; + *) # Relative path. + ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix + ac_top_srcdir=$ac_top_builddir$srcdir ;; +esac + +# Do not use `cd foo && pwd` to compute absolute paths, because +# the directories may not exist. +case `pwd` in +.) ac_abs_builddir="$ac_dir";; +*) + case "$ac_dir" in + .) ac_abs_builddir=`pwd`;; + [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";; + *) ac_abs_builddir=`pwd`/"$ac_dir";; + esac;; +esac +case $ac_abs_builddir in +.) ac_abs_top_builddir=${ac_top_builddir}.;; +*) + case ${ac_top_builddir}. in + .) ac_abs_top_builddir=$ac_abs_builddir;; + [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;; + *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;; + esac;; +esac +case $ac_abs_builddir in +.) ac_abs_srcdir=$ac_srcdir;; +*) + case $ac_srcdir in + .) ac_abs_srcdir=$ac_abs_builddir;; + [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;; + *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;; + esac;; +esac +case $ac_abs_builddir in +.) ac_abs_top_srcdir=$ac_top_srcdir;; +*) + case $ac_top_srcdir in + .) ac_abs_top_srcdir=$ac_abs_builddir;; + [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;; + *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;; + esac;; +esac + + + case $INSTALL in + [\\/$]* | ?:[\\/]* ) ac_INSTALL=$INSTALL ;; + *) ac_INSTALL=$ac_top_builddir$INSTALL ;; + esac + + if test x"$ac_file" != x-; then + { echo "$as_me:$LINENO: creating $ac_file" >&5 +echo "$as_me: creating $ac_file" >&6;} + rm -f "$ac_file" + fi + # Let's still pretend it is `configure' which instantiates (i.e., don't + # use $as_me), people would be surprised to read: + # /* config.h. Generated by config.status. */ + if test x"$ac_file" = x-; then + configure_input= + else + configure_input="$ac_file. " + fi + configure_input=$configure_input"Generated from `echo $ac_file_in | + sed 's,.*/,,'` by configure." + + # First look for the input files in the build tree, otherwise in the + # src tree. + ac_file_inputs=`IFS=: + for f in $ac_file_in; do + case $f in + -) echo $tmp/stdin ;; + [\\/$]*) + # Absolute (can't be DOS-style, as IFS=:) + test -f "$f" || { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5 +echo "$as_me: error: cannot find input file: $f" >&2;} + { (exit 1); exit 1; }; } + echo "$f";; + *) # Relative + if test -f "$f"; then + # Build tree + echo "$f" + elif test -f "$srcdir/$f"; then + # Source tree + echo "$srcdir/$f" + else + # /dev/null tree + { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5 +echo "$as_me: error: cannot find input file: $f" >&2;} + { (exit 1); exit 1; }; } + fi;; + esac + done` || { (exit 1); exit 1; } +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF + sed "$ac_vpsub +$extrasub +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF +:t +/@[a-zA-Z_][a-zA-Z_0-9]*@/!b +s,@configure_input@,$configure_input,;t t +s,@srcdir@,$ac_srcdir,;t t +s,@abs_srcdir@,$ac_abs_srcdir,;t t +s,@top_srcdir@,$ac_top_srcdir,;t t +s,@abs_top_srcdir@,$ac_abs_top_srcdir,;t t +s,@builddir@,$ac_builddir,;t t +s,@abs_builddir@,$ac_abs_builddir,;t t +s,@top_builddir@,$ac_top_builddir,;t t +s,@abs_top_builddir@,$ac_abs_top_builddir,;t t +s,@INSTALL@,$ac_INSTALL,;t t +" $ac_file_inputs | (eval "$ac_sed_cmds") >$tmp/out + rm -f $tmp/stdin + if test x"$ac_file" != x-; then + mv $tmp/out $ac_file + else + cat $tmp/out + rm -f $tmp/out + fi + +done +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF + +{ (exit 0); exit 0; } +_ACEOF +chmod +x $CONFIG_STATUS +ac_clean_files=$ac_clean_files_save + + +# configure is writing to config.log, and then calls config.status. +# config.status does its own redirection, appending to config.log. +# Unfortunately, on DOS this fails, as config.log is still kept open +# by configure, so config.status won't be able to write to it; its +# output is simply discarded. So we exec the FD to /dev/null, +# effectively closing config.log, so it can be properly (re)opened and +# appended to by config.status. When coming back to configure, we +# need to make the FD available again. +if test "$no_create" != yes; then + ac_cs_success=: + ac_config_status_args= + test "$silent" = yes && + ac_config_status_args="$ac_config_status_args --quiet" + exec 5>/dev/null + $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false + exec 5>>config.log + # Use ||, not &&, to avoid exiting from the if with $? = 1, which + # would make configure fail if this is the last instruction. + $ac_cs_success || { (exit 1); exit 1; } +fi + diff --git a/web/src/cgi.tcl-1.10/configure.in b/web/src/cgi.tcl-1.10/configure.in new file mode 100644 index 00000000..7b7f6880 --- /dev/null +++ b/web/src/cgi.tcl-1.10/configure.in @@ -0,0 +1,52 @@ +# Process this file with autoconf to produce a configure script. + +AC_INIT(Makefile.in) +CGI_MAJOR_VERSION=1 +CGI_MINOR_VERSION=10 +CGI_MICRO_VERSION=0 +CGI_VERSION=$CGI_MAJOR_VERSION.$CGI_MINOR_VERSION +CGI_VERSION_FULL=$CGI_VERSION.$CGI_MICRO_VERSION + +# If `configure' is invoked (in)directly via `make', ensure that it +# encounters no `make' conflicts. +# +unset MFLAGS MAKEFLAGS + +# this'll use a BSD compatible install or our included install-sh +AC_PROG_INSTALL + +# Find a usable Tcl executable so that we can run Tcl utilities +# For simplicity, assume Tcl is completely installed. +AC_MSG_CHECKING([for usable Tcl executable]) +for i in \ + ${exec_prefix}/bin/tclsh \ + `ls -r ${exec_prefix}/bin/tclsh[[8-9]]* 2>/dev/null` \ + ${prefix}/bin/tclsh \ + `ls -r ${prefix}/bin/tclsh[[8-9]]* 2>/dev/null` \ + ${srcdir}/../tcl/unix/tclsh \ + `ls -dr ${srcdir}/../tcl[[8-9]]*/unix/tclsh 2>/dev/null` \ + /usr/local/bin/tclsh \ + /usr/bin/tclsh ; do + if test -x "$i" ; then + CGI_TCL_EXECUTABLE=$i + break + fi +done +if test "x$CGI_TCL_EXECUTABLE" = "x" ; then + AC_MSG_ERROR([no tcl executable found, cannot install]) +else + AC_MSG_RESULT($CGI_TCL_EXECUTABLE) +fi + +# +# Set up makefile substitutions +# +AC_SUBST(CGI_MAJOR_VERSION) +AC_SUBST(CGI_MINOR_VERSION) +AC_SUBST(CGI_MICRO_VERSION) +AC_SUBST(CGI_VERSION_FULL) +AC_SUBST(CGI_VERSION) +AC_SUBST(CGI_LIB_FILE) +AC_SUBST(CGI_LIB_FILES) +AC_SUBST(CGI_TCL_EXECUTABLE) +AC_OUTPUT(Makefile cgi.tcl version) diff --git a/web/src/cgi.tcl-1.10/doc/ref.txt b/web/src/cgi.tcl-1.10/doc/ref.txt new file mode 100644 index 00000000..79ddd721 --- /dev/null +++ b/web/src/cgi.tcl-1.10/doc/ref.txt @@ -0,0 +1,1651 @@ +cgi.tcl - A Reference Manual (Draft) +by Don Libes + +This document contains technical notes on using cgi.tcl. This +document is a draft and has not been officially reviewed. + +This document assumes that you have read the Tcl '96 paper "CGI +Scripting in Tcl". That document will give you the feel for what this +code is all about. In contrast, this document provides the details. + +This document assumes you know HTML. I'm not going to explain what +particular tags do or how to use them effectively, except as necessary +to understand the document. + +Some of the commands may not work with all browsers. For example, the +cgi_center command is generally understood only by some Netscape +browsers because it produces <center></center> tags which are not +commonly supported. You'll have to use your judgement. Remember: +Just because a command exists to produce the HTML doesn't mean your +browser will do anything meaningful with it. In that sense, using +this code is no different than handcoding HTML. + +************************************************** +A NOTE ABOUT PROCEDURE NAMES +************************************************** + +All procedures are named cgi_XXX. You can also call them without the +cgi_ prefix. Using the cgi_XXX form is no big deal for rarely used +procedures, but the aliases are particularly convenient for things +like hr and br. Aliases are suppressed if procedures exist by those +names already. (Thus, cgi_eval cannot be invoked as "eval"!) +Similarly, you can overwrite the aliases with impunity. Internally, +references are only made to the cgi_ names. + +I'm still thinking about this. If you have strong feelings about it, +let me know. + +************************************************** +SECURITY +************************************************** + +I frequently see statements saying that Tcl (and other interpretive +languages, for that matter) are insecure and should not be used for +writing CGI. + +I disagree. It is possible to use Tcl securely and it really isn't +very hard. The key, of course, is to not blindly evaluate user input. +There really isn't much reason to. For instance, this library itself +is pretty big and does lots of things, but nothing in it evaluates +user input. (It does do a lot of evaluation of *programmer* input, +but that's quite acceptable.) + +The two classes of commands you should pay close attention to are +commands that do eval operations and commands that invoke external +programs. + +************************************************** +GENERAL NOTES ABOUT PARAMETERS +************************************************** + +** There are several basic styles of parameter passing. + +-- Container commands (e.g., <body></body>, <div></div>, etc.) + +The last argument is typically a block of code. Other arguments +become attributes. For example: + + cgi_body bgcolor=red background=white { + h4 "hello" + } + +produces: + + <body bgcolor="red" background="white"> + <h4>hello</h4> + </body> + +-- Commands with required arguments + +Some commands have required arguments. Required arguments which are +relatively long, are passed *after* all others. For example: + + cgi_h4 align=left "Foo's Bar & Grill" + +Another example: + + cgi_body bgcolor=red background=white { + cgi_h4 "Foo's Bar & Grill" + } + +Commands with relatively short arguments have the short arguments +passed *before* all others. This avoids many redundant keywords. In +the following example, the "img=" is omitted because it is already +implied by the command. The "alt=" is not optional (although the +entire argument is). + + cgi_img foo.gif "alt=Foo's Bar & Grill" + +Note the quotes around the alt argument. This is only necessary if +the argument has whitespace in it - a consequence of Tcl's normal +scanning rules. The resulting HTML automatically includes quotes +around the value attribute. (See Case-sensitivity.) + +** Case-sensitivity and Quotes and Whitespace + +Attribute names are case sensitive. Use lowercase names for "normal" +handling. For example, values for attributes such as "url" and +"value" are quoted and encoded. Use uppercase names to suppress the +usual processing. (For example, you might want to test how a browser +responds to incorrect HTML.) + +Consider: + + cgi_body bgcolor=#123456 { + p [cgi_img foo.gif "alt=Foo's Bar & Grill"] + } + +This is translated to + + <body bgcolor="#123456"> + <p><img src="foo.gif" alt="Foo's Bar & Grill"></p> + </body> + +Notice how the ampersand in the alt value has been encoded. Also +notice how quotes have been added to the values of bgcolor, url, and +alt. Thus you no longer have to add quotes all over the place (or +remember when you need to). + +Embedded whitespace is protected by quoting in the usual Tcl fashion +rather than typical HTML fashion. + +So instead of: + img foo.gif alt="foo bar" +do this: + img foo.gif "alt=foo bar" +which will return HTML that is properly quoted: + <img src="foo.gif" alt="foo bar"> + +-- Name-value commands + +Many commands produce tags that use "name" and "value" attributes. +Because these attributes are almost always used in such commands, the +first argument is always of the form name=value so the literal "name" +and "value" can be omitted. For example: + + cgi_text color=Red size=5 + +produces: + + <input name="color" value="Red" size=5> + +Reasonable defaults exist. For example, if you don't need the value +of a submit button (but the user still needs to see it appear as the +label), omit the name: + + cgi_submit_button =Execute + +If no "=" is present, the string is assumed to be the "name" +attribute. For example: + + cgi_checkbox Vegies + +produces a checkbox associated with the variable named "Vegies". +(With no specified value, it will be set to "on" if checked.) + +Most of the commands have reasonable defaults. For example, to +quickly script a submit button, the following suffices: + + cgi_submit_button + +Certain constructions make no sense and are therefore disallowed. For +example, a submit button with a name but no value makes no sense, so +cgi_submit_button doesn't allow it. (In other words, if you provide +an argument, it has to have "=" in it.) + +************************************************** +JAVASCRIPT ARGUMENTS +************************************************** + +JavaScript event attributes such as onClick are handled just like any +other attributes in terms of quoting and case sensitivity. Because +there are so many attributes on so many tags, they are not documented +explicitly in this manual. However, they are all supported. Here is +an example: + + cgi_text age=18 onChange=MinimumAge(this.form.age) + +************************************************** +PROCEDURES TO ASSIST IN DEBUGGING +************************************************** + +** User-id differences + +You can interactively run and debug CGI scripts by simply running them +from the shell, or a Tcl or C debugger. (For convenience, I use +Expect instead of tclsh just so that I get the debugger.) In fact, +I've never had to resort to the C debugger. However, simply watching +the raw output from a shell is very handy. This catches the really +basic errors such as incorrect protections, incorrect #! line, etc. +Once your script is actually executing, you can rely on cgi_eval (see +below). + +cgi_uid_check user + +Typically, a CGI script is intended to run from a particular uid, such +as "nobody". If you run such scripts interactively, you can end up +with conflicts. For example, if the script creates files, files can +accidentally end up being owned by you. + +cgi_uid_check is a convenient mechanism to warn against this problem. +Simply call cgi_uid_check in your script. The argument is the uid +under which the script should be running. If the given uid does +not match the actual uid, cgi_uid_check will generate an error. + +** Trapping error messages + +cgi_eval + +cgi_eval is the primary error catching/reporting mechanism. Execute +commands from cgi_eval so that errors can be caught and reported in a +nice way. By default, errors are emailed back to the administrator. +"cgi_debug -on" makes errors be immediately viewable in the browser. + +If an error is caught when debugging is enabled, the diagnostic is +anchored with #cgierror. This is useful in scripts that produce +voluminous output. + +cgi_error_occurred + +cgi_error_occurred returns 1 if an error occurred and was caught by +cgi_eval. This separate function simplifies exit handling - for +example, rather than always checking the return value of cgi_eval, an +app can just test this from a redefined exit. + +cgi_admin_mail_addr addr + +cgi_admin_mail_addr sets the administrator's email address. +Diagnostics are sent via email if a problem is encountered with the +script and debugging is not enabled. + +cgi_name name + +cgi_name defines a name for the service. If called with no arguments, +the name is returned. The name is currently used in the following +places: + + If email is sent, it comes from [cgi_name]. + If errors are emailed, the subject is "[cgi_name]: CGI problem" + +** Generating debugging output and other commands + +cgi_debug args + +cgi_debug provides rudimentary support for generating debugging +messages. Here are some example calls: + +cgi_debug cmd + If debugging is on, the command is evaluated. For example: + + cgi_debug { + h2 "completed initialization" + } + or + cgi_debug {h2 "completed initialization"} + + Note this is more than simply calling h2. Context is rewound + or forwarded to get to a place where this is safe. (And + conversely, this call can suppress things such as header + elements that haven't been processed yet.) The flag + "-noprint" suppresses this manipulation - this is useful for + early code that causes no printing. + + The -- flag causes the next argument to treated as a command + even if it looks like another flag. +cgi_debug -on + Enables debugging messages. This includes debugging messages + generated by explicit calls to cgi_debug as well as implicit + diagnostics, for example, that report on form input. +cgi_debug -temp text + Enable debugging for this one line. +cgi_debug -off + Disable debugging. + +cgi_debug always returns the old setting ("-on" or "-off"). The +initial value is -off. + + +** Printing arrays + +cgi_parray arrayname + +cgi_parray prints out the elements of a Tcl array. cgi_parray is just +like Tcl's parray except that its output is appropriately formatted +for a browser. + +************************************************** +BASIC STRUCTURE OF A CGI SCRIPT +************************************************** + +Typically, the basic structure of most CGI scripts is: + + package require cgi + + cgi_eval { + cgi_http_head {cmds} + cgi_html { + cgi_head {cmds} + cgi_body {cmds} + } + } + +Much of this can be omitted, however. In fact, a typical script looks +more like this: + + package require cgi + + cgi_eval { + cgi_title "title" + cgi_body { + cmds + } + } + +(If you're not using the Tcl package support, replace the 'package +require' command with a 'source' command of the specific file +containing the cgi.tcl source.) + +(The "...." in the examples above should be replaced by the true path +to the cgi.tcl file.) + +I'll now go through each of these in more detail as well as some other +possibilities for the overall structure. + +************************************************** +HTTP HEADERS +************************************************** + +cgi_http_head cmds + +CGI scripts must produce various headers to explain how the remainder +of the output is to be interpreted. No other output may preceed this! + +With no argument, an HTML content type is produced if the script is +running in the CGI environment. This means that most people need not +bother calling cgi_http_head. However, if you want to see the HTTP +headers and you are not running in the CGI environment, you should +call cgi_http_head explicitly. (Alternatively, you can make it appear +that you are in the CGI environment by defining the environment +variable REQUEST_METHOD.) + +The remaining commands in this section may be used in cgi_http_head. +Most should be intuitively obvious and thus need no explanation. + +cgi_content_type type + Generates a "Content-type:" header. + +With no argument, cgi_content_type generates a declaration for HTML. +If specified, the 'type' argument should be the full MIME-style +type/subtype declaration. Any MIME-style parameters should be +included in the type argument. + +cgi_redirect location + Generates a redirect header (Status:/Location:/URI:) +cgi_target + Generates a "Window-target:" header. +cgi_refresh seconds url + Generates a "Refresh:" header. The url argument is optional. +cgi_pragma pragma + Generates a "Pragma:" header. +cgi_status number string + Generates a "Status:" header. + +** Cookies + +cgi_cookie_set name=val args + Define a cookie with given name, value, and other arguments. + Cookie values are automatically encoded to protect odd characters. + A couple expirations are predefined (with intuitive meaning): + expires=never + expires=now + expires=...actual date... + + Here are some examples: + cgi_cookie_set user=don domain=nist.gov expires=never + cgi_cookie_set user=don expires=now secure + +cgi_export_cookie name args + Export the named Tcl variable as a cookie. Other arguments are + processed as with cgi_cookie_set. + +Cookies may be read only after calling cgi_input. The following +routines read cookie names or specific cookies. + +cgi_cookie_list + Returns the list of all cookies supplied by the server. + +cgi_cookie_get name + Returns the value of the named cookie. If multiple values exists + the most specific path mapping is used. + + If the "-all" flag is used (before the cookie name), a list is + returned containing all cookie values for the given name. The + list is ordered most-specific (path mapping) to least. I.e., + the first value on the list is the same one returned by + calling cgi_cookie get without a flag. + +cgi_import_cookie name + Define a Tcl variable with the value of the cookie of the same + name. For example, the following command retrieves the cookie + named "Password" and stores it in the Tcl variable "Password". + + cgi_import_cookie Password + + +************************************************** +GENERATING HTML +************************************************** + +cgi_html + +<html></html> tags can be generated using cgi_html. An argument to +cgi_html is evaluated to produce the actual HTML code. + +In practice, it is not necessary to use cgi_html. CGI.tcl will +automatically generate the tags when appropriate. (Oddly, modern HTML +specs don't require it and most if not all browsers never cared +anyway.) + +cgi_doctype + +cgi_doctype is a user-defined procedure that produces a SGML DOCTYPE +declaration. If it exists, cgi_doctype is automatically invoked at +the beginning of cgi_html. (This library does not automatically create +DOCTYPE declarations since the library is not restricted to generating +SGML for any single DTD. Realistically, DOCTYPEs are pointless for +HTML generation since web browsers don't require DOCTYPE declarations. +However, if you are creating pages for some other purpose that +requires such a declaration, use cgi_doctype.) + +cgi_head + +<head></head> tags can be generated using cgi_head. An argument to +cgi_head is evaluated to produce the actual headers. + +In practice, it is not necessary to use cgi_head. CGI.tcl will +automatically generate the tags when appropriate. (Oddly, modern HTML +specs don't require it and most if not all browsers never cared +anyway. So for example: + + cgi_head { + cgi_title "my page" + } + +is equivalent to: + + cgi_title "my page" + +Note that cgi_title will be called automatically if you omit +cgi_title, cgi_head, or call cgi_head with no arguments. + +cgi_title title + +cgi_title defines the title of a page. It is called from within a +<head></head> pair. If not called from within cgi_head, it implicitly +forces it to occur. + +cgi_title always returns the title. With no argument, cgi_title +returns the old title without changing it. + +cgi_http_equiv + +cgi_http_equiv is equivalent to cgi_http_head but from within +cgi_head. This procedure is defined for completeness - there is no +reason to use it. In fact, it doesn't allow all cgi_http_head +declarations, so it should be avoided. + +cgi_meta + +cgi_meta generates a <meta> tag. You can do whatever you want with +these. (Read some an HTML document for more info.) For example: + + meta name=author {content="Don Libes"} + +cgi_script cmd + +cgi_script evaluates its arguments inside of <script></script> tags. +This is appropriate for putting in client-side scripting. Optional +arguments are passed as attributes to the <script> tag. + +Note that the cmd argument is a Tcl command, not a command in the +other scripting language. So if all you want to do is print out some +script, use cgi_puts: + + cgi_script { + cgi_puts { + some scripting stuff + in whatever weird funky + language you want + } +} + +cgi_javascript cmd + +cgi_javascript is a version of cgi_script specialized for javascript. +At present, all it does is add the comment hacks so that the +javascript can't be seen by old browsers. + +cgi_noscript cmd + +cgi_noscript evaluates its argument to generate code for browsers that +do not understand cgi_script or its variants. + +cgi_body + +<body></body> tags are generated using cgi_body. An argument to +cgi_body is evaluated to produce the actual body. + +Executing "return" from within cgi_body causes cgi_body to return. +This is useful if more code follows the cgi_body within the cgi_eval. +Compare to cgi_exit (see elsewhere). + +cgi_body_args + +Arguments to cgi_body_args are made available to cgi_body as if they +had been specified in the call to cgi_body. This provides a +convenient way for using the same colors, backgrounds, etc, in a set +of pages. + +cgi_exit + +cgi_exit provides a fast way of cleanly exiting a CGI script without +having to manually unwind procedures. In particular, cgi_exit forces +closure of all open tags. It then calls exit. This is useful if you +want to exit from a CGI script at any point and still have the HTML be +correct. + +** Frames + +cgi_frameset cmd + +Instead of cgi_body, you can call cgi_frameset to create framed +documents. This produces <frameset></frameset> tags with the content +filled by evaluation of cmd. Optional arguments are passed on as +attributes. + +cgi_frame name=url + +cgi_frame defines a frame with the given name and url. The argument +handling is the same as for other name-value commands (even though the +value here is a url). The url is automatically double-quoted. Other +optional arguments are passed on as attributes. + +cgi_noframes cmd + +cgi_noframes produces <noframes></noframes> tags with the content +filled evaluation of cmd. Optional arguments are passed on as +attributes. + +************************************************** +CONTAINER SUPPORT +************************************************** + +cgi_division + +cgi_division evaluates its last argument, grouping it together. This +is useful for acting on a group of paragraphs, such as for alignment +purposes. + +cgi_center + +cgi_center is similar to "cgi_division align=center". + +************************************************** +SINGLE PARAGRAPH SUPPORT +************************************************** + +Everything in this section generates a single paragraph or line break. +Most of these take a string as the last argument which is +appropriately formatted. Any other arguments are used as tag +attributes. + +cgi_p +cgi_address +cgi_blockquote +cgi_h1 through h7 + +Most of these procedures should be intuitive. They all take a string +and display it in the appropriate way. For example, a level 2 +heading: + + h2 "Paragraph Support" + +Here's a paragraph with some formatting (see next section for more +info): + + p "I [bold love] Tcl but hate [blink "blinking text"]" + +Note that some of these generate tags that are not supported by all +browsers. See the format-tour.cgi script to see these in use. + +cgi_br + +cgi_br causes a paragraph break to be printed. Additional arguments +are passed on as attributes. + +To embed a paragraph break (rather than printing it), use cgi_nl. In +the following example, it is much more convenient to call cgi_br than +cgi_nl: + + radio_button "version=1" + br + radio_button "version=2" + +See cgi_nl for more info. + +************************************************** +TEXT SUPPORT +************************************************** + +The following procedures take a string and return an appropriately +formatted version. The string is always the last argument. Any other +arguments are used as tag attributes. + +cgi_bold +cgi_italic +cgi_underline +cgi_strikeout +cgi_subscript +cgi_superscript +cgi_typewriter +cgi_blink +cgi_emphasis +cgi_strong +cgi_cite +cgi_sample +cgi_keyboard +cgi_variable +cgi_definition +cgi_big +cgi_small +cgi_font + + p "I [bold love] Tcl but hate [blink "blinking text"]" + +Note that some of these generate tags that are not supported by all +browsers. See the format-tour.cgi script to see these in use. + +cgi_basefont + +cgi_basefont defines the base font. + +************************************************** +SPECIAL CHARACTERS OR CHARACTER SEQUENCES +************************************************** + +The following procedures produce characters such that when interpreted +by a browser returns the indicated character. + + Returns +cgi_lt < +cgi_gt > +cgi_amp & +cgi_quote " +cgi_enspace en space +cgi_emspace em space +cgi_nbspace nonbreaking space +cgi_tm registered trademark +cgi_copyright copyright +cgi_isochar n ISO character #n + +cgi_nl + +cgi_nl returns a paragraph break string suitable for embedding in a +string just as you would embed a newline in a Tcl string via \n. + +To print a paragraph break rather than returning it, use cgi_br. In +the following example, it is much more convenient to call cgi_nl than +than cgi_br: + + h2 "This appears[nl]on two lines." + +See cgi_br for more info. + +cgi_breakable + +cgi_breakable indicates a place in a word at which the browser can +break a string across two lines. + +cgi_unbreakable cmd + +cgi_unbreakable evaluates a cmd in such a way that the output will not +be broken across lines by the browser just because the screen width is +exceeded. Instead a horizontal scrollbar will appear so that the +browser can be manually scrolled to see the long line. +n +cgi_unbreakable_string string + +cgi_unbreakable_string returns its arguments so that it will not be +broken across lines by the browser just because the screen width is +exceeded. Instead a horizontal scrollbar will appear so that the +browser can be manually scrolled to see the long line. + +Notes: + +- It is my assumption that cgi_unbreakable will be much more commonly +used than the _string version, hence the choice of names. Feel free +to let me know what I'm wrong. + +- I have seen browsers handle unbreakables incorrectly, particularly +in interaction with other features. If you can't get your +unbreakables to behave correctly, consider alternative layouts or +alternative HTML. For example, unbreakable table data should be done +using "table_data nowrap". I have no idea why but it works whereas +unbreakable causes the table rows to overlap. Clearly, this is a +browser bug. + +************************************************** +FORMS +************************************************** + +cgi_form action args cmd + +cgi_form defines a form. The form is populated by executing the +command (last argument of cgi_form). action defines the url to +process the form. Any other arguments are passed as attributes. +A typical call looks like this: + + cgi_form response { + .... + } + +Here "response" names the URL to process the form. If the URL does +not begin with a protocol name (such as "http:"), a common root is +prepended and ".cgi" is appended. This can be changed by redefining +the procedure cgi_cgi. + +cgi_root + +cgi_root defines the common root used by cgi_form (see above). +For example: + + cgi_root "http://www.nist.gov/cgi-bin/cgi.tcl-examples" + +With one argument, cgi_root returns the new root. With no arguments, +cgi_root returns the old root. + +cgi_suffix + +cgi_suffix defines the common suffix used by cgi_cgi and anything that +uses it such as cgi_form. The default suffix is ".cgi". + +cgi_cgi +cgi_cgi_set + +cgi_cgi controls exactly how cgi_form creates URLs from its action +argument. By default, cgi_cgi takes an argument, prepends [cgi_root] +and appends [cgi_suffix]. The suffix can be overridden by using the +-suffix flag and an argument to be used instead of [cgi_suffix]. + +Any additional arguments are joined together in the style required for +a GET style request. These arguments should be preformatted using +cgi_cgi_set to guarantee proper encoding. For example: + + cgi_cgi myscript \ + [cgi_cgi_set owner "Don"] \ + [cgi_cgi_set color "black & white"] + +generates: ....?owner=Don&color=black+%26+white + +cgi_isindex + +cgi_isindex generates an <isindex> tag. Optional arguments are passed +on as attributes. In the processing CGI script, the value of the +isindex query is found in the "anonymous" variable. + +cgi_relationship rel url + +cgi_relationship expresses a relationship between this document and +another. For example, the following says that the url named by +homepage is the home document of the current document. + + cgi_relationship home $homepage + +Optional arguments are passed on as additional attributes. Here's an +example that references an external style sheet that is a CSS type +(cascading style sheet). + + cgi_relationship stylesheet basic.css type=text/css + + +************************************************** +INPUT +************************************************** + +cgi_input + +CGI input means "cookies, files, and get/post data". cgi_input reads +in all input, decodes it, and makes it available to a variety of other +routines. + +For debugging, cgi_input can be given arguments to fake input. This +allows you to run your cgi_script interactively or under a debugger +(either Tcl or C debugger). Provide GET/POST data as the first +argument. Provide cookie data as the second argument. The arguments +should be encoded (see cgi_cgi_set). For example: + + cgi_input "name=libes&old=foo&new1=bar&new2=hello" + +This is convenient because when you run into a misbehaving CGI script, +the first thing it does is tell you the input in exactly this format. +Simply cut and paste it into your program and you can then +interactively debug it without using the real form or the CGI server. + +If cgi_input is invoked from the CGI environment, the fake inputs are +ignored. (If you want to force fake inputs in the CGI environment, +unset env(REQUEST_METHOD). + +Forms encoded as multipart/form-data are usually used to handle file +input. Since file data usually implies a large amount of data, the +data is saved to /tmp/CGIdbg.[pid] if debugging is enabled. This file +can be fed back to cgi_input by providing the filename as the first +argument of cgi_input. In addition, env(CONTENT_TYPE) must be set to +the appropriate content type. This can found in env(CONTENT_TYPE). +Removal of the debugging file is the responsibility of the script or +the script programmer. (Typically, I examine the file after my CGI +script is over and then delete them by hand.) + +Execs before cgi_input reads POST data should have standard input +redirected ("< /dev/null" for instance) so that the exec'd process +doesn't inherit the CGI script's standard input. + +** Form elements that generate lists + +Variable names should only end with "List" if they correspond to form +elements which generate multiple values (some but not all uses of +select, checkbox, etc). List variables will be given Tcl-style list +values. + +If cgi_input encounters multiple values for variables that do not end +with List, it will provide the values in a Tcl-style list. However, +this leaves an ambiguity in the case of a single value that "looks" +like a list, such as "a b". Although a form author can usually "know" +whether a string is a list or not, it is simpler to stick to the +convention stated earlier. + +Here are examples: + + # pull-down menu + cgi_select Foo { + cgi_option "a" + cgi_option "a b" + } + + # scrolled list, allow multiple selections + cgi_select FooList multiple { + cgi_option "a" + cgi_option "a b" + } + +** Getting at the input + +Input is made available in two ways: variables, files, and cookies. + +-- Variables and Cookies + +cgi_import_list + +cgi_import_list returns a list of variable names supplied as input to +the script. + +cgi_cookie_list + +cgi_cookie_list returns a list of cookie names supplied to the script. + +cgi_import name + +cgi_import retrieves the value of the named variable and places it in +a Tcl variable of the same name. The value is also returned as the +return value. + +cgi_import_as name tclvar + +cgi_import_as is similar to cgi_import but the value is assigned to +the Tcl variable named by the second argument. + +cgi_import_cookie name + +cgi_import is similar to cgi_import, however if the cgi variable does +not exist, the value is fetched from the cookie by that name. (This +allows the user to override a cookie if the form allows it.) + +cgi_import_cookie_as name tclvar + +cgi_import_cookie_as is similar to cgi_import_cookie but the value is +assigned to the Tcl variable named by the second argument. + +cgi_cookie_get name + +cgi_cookie_get returns the value of the named cookie. + +-- Files + +cgi_import_file -server name +cgi_import_file -client name +cgi_import_file -type name + +cgi_import_file returns information about an uploaded file. "name" is +the string from the original form. The Content-type is returned via +-type. (This may be empty or even undefined in which case +cgi_import_file should be caught.) + +Uploaded files are saved on the CGI server. To avoid collisions with +other file upload instances, files are not stored in their original +names. The name of the file as it is stored on the CGI server is +retrieved using the "-server" flag. The original name of the file as +it was stored on the user's host is retrieved using the "-client" +flag. + +Uploaded files are the responsibility of the CGI programmer. In +particular, if you do not delete them, they will remain until /tmp is +cleaned up in some other way. + +If the user does not enter a filename, an empty file will be delivered +with a null remote filename. + +cgi_file_limit files chars + +cgi_file_limit establishes limits on the number of files and their +size. This is provided to prevent denial of service attacks. If the +limit is exceeded, an error is raised from within cgi_input. + +Note that when the limit is exceeded, cgi_input fails immediately. So +if you just want to check file sizes that are not security related - +for example, you just want to accept gifs under 10K - it's better to +accept the gifs and then check the size manually (i.e., [file size +...]. That way, cgi_input will completely read all the variables and +you can give more appropriate diagnostics. + +The default limit is 10 100MB files. If you were to set this +yourself, it would look this way: + +cgi_file_limit 10 100000000 + + +-- File example + +The following code echos the contents of a file that was +uploaded using the variable "file": + + cgi_input + cgi_body { + set server [cgi_import_filename -server $v] + set client [cgi_import_filename -client $v] + if [string length $client] { + h4 "Uploaded: $client, contents:" + cgi_preformatted {puts [exec cat $server]} + } + file delete $server + } + +The present implementation supports binary upload if you are using Tcl +8.1 (or later) or if you are using the Expect extension. If you are +using a version of Tcl earlier than 8.1 with Expect but want to +suppress binary loading, create the global variable +_cgi(no_binary_upload). (The reason you might want to suppress binary +loading is that it is noticably slower.) + +************************************************** +EXPORT +************************************************** + +Form elements automatically export their values. See FORM ELEMENTS +for more information. + +cgi_export name=value + +cgi_export makes the named variable available with the given value. +The "=value" is optional. If not present, the value of the Tcl +variable by the same name is used. + +cgi_export is implemented with variables of type=hidden. + +cgi_export is implemented as an all-or-nothing operation. In +particular, no HTML is emitted if the variable does not exist. That +means it is not necessary to test for existence in situations where +you would like to export a variable IF it exists. Rather, it is +sufficient to embed cgi_export within a catch. For example, the +following generates nothing if xyz doesn't exist and it generates the +appropriate HTML if xyz does exist. + + catch {cgi_export xyz} + +** Cookies + +cgi_export_cookie name + +cgi_export_cookie is similar to cgi_export except that the value is +made available as a cookie. Additional arguments are handled as with +cgi_cookie_set (see below). + +cgi_cookie_set name=val + +cgi_cookie_set sets the named cookie. All optional arguments are +handled specially. All arguments are encoded appropriately. The +expires keyword is handled specially to simplify common cases. In +particular, the values "now" and "never" produce appropriate GMT +values. + +Here are some example of cgi_cookie_set: + + cgi_cookie_set user=don domain=nist.gov expires=never + cgi_cookie_set user=don domain=nist.gov expires=now + cgi_cookie_set user=don domain=nist.gov expires=...actual date... + +Note that cookie setting must be done during http head generation. + +************************************************** +URL/IMG DICTIONARY SUPPORT +************************************************** + +cgi_link tag +cgi_link tag display url + +cgi_link provides a convenient mechanism for maintaining and +referencing from a set of URLs. + +cgi_link returns the string <A>...</A> corresponding to the given tag. +A tag is defined by calling cgi_link with the tag, the clickable text +that the use should see, and the url. + +For example, suppose you want to produce the following (where _xyz_ +indicates xyz is a hyperlink): + + I am married to _Don Libes_ who works in the _Manufacturing + Collaboration Technologies Group_ at _NIST_. + +Using cgi_link with appropriate link definitions, the scripting to +produce this is: + + p "I am married to [link Libes] who works in the [link MCTG] + at [link NIST]." + +This expands to: + + I am married to <A HREF="http://elib.cme.nist.gov/msid/staff + /libes/ libes.don.html">Don Libes</A> who works in the <A + HREF="http:// elib.cme.nist.gov/msid/groups/mctg.htm"> + Manufacturing Collaboration Technologies Group</A> at <A + HREF="http:// www.nist.gov">NIST</A>. + +The links themselves are defined thusly: + + link Libes "Don Libes" http://www.cme.nist.gov/msid/staff/libes + link MCTG "$MCT Group" http://www.cme.nist.gov/msid/mctg + link NIST "NIST" http://www.nist.gov + +Now if my home page ever changes, rather than updating every +occurrence, I just have to edit the one definition. + +Tcl variables can further simplify updates. For instance, URLs for +Libes and MCTG are in a common directory. It makes sense to store +that in a single variable. Rewritten this appears: + +set MSID http://www.cme.nist.gov/msid + + link Libes "Don Libes" $MSID/staff/libes + link MCTG "$MCT Group" $MSID/mctg + link NIST "NIST" http://www.nist.gov + +Then if the MSID directory ever moves, only one line need be updated. +This may seem like no big deal here, but if you have many links and +many uses of them, this pays off handsomely. + +Optional attributes can be provided as additional arguments (see IMG +example below). + +An existing link can be given a different "display" temporarily by +calling cgi_link with the different display and omitting the url. + +cgi_imglink + +imglink works similar to cgi_link (see that documentation for more +info) except that no display argument is used and the second argument +is assumed to be the image source. Example: + + imglink taj tajmahal.gif + +Other attributes can be provided as additional arguments. + + imglink taj tajmahal.gif "alt=The Taj Mahal" + +cgi_url display href args + +By using cgi_url, URLs can be generated immediately (without using +cgi_link first). This is convenient when you need a URL that will +only appear once - so that there is no point in storing it in a +dictionary. For example: + + cgi_li "[cgi_url "Plume" http://pastime.anu.edu.au/Plume] + is a Tcl-based WWW browser written by Steve Ball, + Australian National University. Among its interesting + features is the ability to execute Tcl applets and the + ability to dynamically extend the browser at runtime." + +cgi_img href args + +cgi_img returns a formatted <img> tag. It is useful for one-time tags. +Tags that are used multiple times should use cgi_imglink. Example: + + cgi_img foo.gif "alt=Foo's Bar & Grill" + +cgi_anchor_name name + +cgi_anchor_name returns an anchor that can be used in an HTML body +that it can be linked to using the #name syntax. For example, to make +a heading that you want to be able to link to: + + h2 "[cgi_anchor_name future]Future Improvements" + +Then to reference the "future" tag: + + p "Look for [cgi_url "improvements" #future] in the future." + +cgi_base args + +cgi_base defines a base or window target for urls. + +************************************************** +QUOTING +************************************************** + +cgi_unquote_input string + +cgi_unquote_input undoes "url-encoding" and returns the result. This +is normally applied automatically to input sources including URLs and +cookies. So you shouldn't have to call this manually. + +cgi_quote_html string + +cgi_quote_html returns the string but with any html-special characters +escaped. For example, "<" is replaced by "\<". This is useful for +displaying a literal "<" in the browser. + +cgi_dquote_html string + +cgi_dquote_html does the same thing as cgi_quote_html but also adds on +double quotes. cgi_quote_html is called automatically for implicit +value attributes. + +cgi_quote_url string + +cgi_quote_url quotes strings appropriately to appear in a url, cookie, +etc. This is useful if you want to publish a url by hand (and must do +the conversion manually that the client normally does for you). + +If you are generating cgi-style URLs for forms, use cgi_cgi_set. + +cgi_preformatted cmd + +cgi_preformatted evaluates its last argument to produce fixed-width +preformatted output. Optional arguments are passed as attributes to +the tags. + +cgi_preformatted allows a subset of tags to be interpreted by the +browser. For example, the <a> tag is interpreted but font change tags +are not. To prevent all interpretation, use cgi_quote_html. For +example, the following prints a file that might contain HTML but +without any risk to throwing off formatting. + + cgi_preformatted { + puts [cgi_quote_html [read $fid]] + } + +************************************************** +LIST SUPPORT +************************************************** + +** List elements + +cgi_li string + +cgi_li prints its string as a list element. Optional arguments are +passed through as attributes. cgi_li does not have to appear in a +list container, but it can. + +cgi_term text +cgi_term_definition text + +cgi_term and cgi_term_definition are usually paired up (although they +need not be) to creates terms and defintions. They do not have to +appear in a list container, but usually appear in a cgi_definition_list. + +** List containers + +cgi_number_list cmd +cgi_bullet_list cmd + +cgi_number_list and cgi_bullet_list take their cmd argument and +evaluate it in a list container context. (I don't know about you but +I could never remember <ol>, <ul>, and all the other ones. This names +seem much easier to remember.) + +cgi_li is a typical command to call inside of a list container, but +you can use regular paragraphs (or anything else) as well. + +cgi_definition_list + +cgi_definition_list is the usual list container for cgi_term and +cgi_term_definition. It may contain other things as well. + +cgi_menu_list +cgi_directory_list + +cgi_menu_list and cgi_directory are more list containers with the +obvious semantics. Previous remarks about other list containers +apply. + +************************************************** +TABLE +************************************************** + +cgi_table cmd + +cgi_table produces <table></table> tags with the content filled by +evaluation of cmd. Optional arguments are passed on as attributes. + +cgi_caption cmd + +cgi_caption produces <caption></caption> tags with the content filled +by evaluation of cmd. Optional arguments are passed on as attributes. + +cgi_table_row cmd +cgi_table_head cmd +cgi_table_data cmd + +These functions all produce the appropriate tags with the content +filled by evaluation of cmd. Optional arguments are passed on as +attributes. + +cgi_tr table_data +cgi_td table_data +cgi_th table_data + +cgi_tr, cgi_td, and cgi_th are shortcuts for relatively simple rows. + +cgi_td outputs a table element. Unlike cgi_table_data, the argument +is not evalled. This allows more terse specification of simple rows. +The following example produces a table with three elements, the last +of which is prevented from wrapping: + + table_row {td Don;td Steve;td nowrap "Really Long Name"} + +As the example suggests, optional arguments are passed on as +data-specific attributes. + +cgi_th is identical to cgi_td except that it produces table heading +elements. + +cgi_tr outputs a row of elements without having to call cgi_td or +cgi_table_data. As with td, eval is not called. Data-specific +attributes cannot be provided. All the elements are passed as a +single argument. For example: + + tr {Don Steve {Really Long Name}} +or + tr [list Don Steve $reallylongname] + +Optional arguments are passed on as row-specific attributes. + +************************************************** +BUTTON +************************************************** + +cgi_submit_button name=value +cgi_radio_button name=value +cgi_image_button name=value + +These procedure create buttons. The first argument indicates the +variable name and value. (See notes on "Name-value" commands earlier +to understand behavior of omitted names/values.) Unless otherwise +mentioned below, additional arguments are passed on as attributes. + + cgi_submit_button "=Submit Form" + cgi_submit_button "Action=Pay Raise" + + cgi_radio_button "version=1" + cgi_radio_button "version=2" checked=1 + + cgi_image_button "=http://www.cme.nist.gov/images/title.gif" + cgi_image_button "Map=http://www.cme.nist.gov/images/msid3.gif" + +Groups of radio buttons must share the same variable name. To address +the obvious question: No, there is no single command to produce a +group of radio buttons because you might very well want to do +arbitrarily-complex calculations in between them. And with a +long-enough line of buttons, the obvious behavior (laying them all out +in a line like CGI.pm does) makes it hard to tell at a glance if the +buttons associate with the label to the left or the right of them. +Anyway, you'll almost certainly want to write another procedure to +call cgi_radio_button and that can control the variable name. + +The radio button argument "checked_if_equal=xxx" indicates that the +button should be shown selected if its associated value is xxx. This +is handy if you are creating radio buttons by iterating over a list. + +The radio button "checked=value" indicates that the button should be +shown selected if the value is a boolean of value true. + +All other arguments are passed on as attributes. + +cgi_file_button name + +cgi_file_button provides a filename entry box. When the form is +submitted, the file is "uploaded" (sent from the client to the +server). The argument enctype=multipart/form-data must be given to +the cgi_form command when using cgi_file_button. + +After uploading, the file is the responsibility of the CGI programmer. +In particular, if you do not delete it, it will remain until /tmp is +cleaned up in some other way. + +For example, to upload a single file, the form might look like this: + + cgi_form upload height=3 enctype=multipart/form-data { + cgi_file_button file + cgi_submit_button =Upload + } + +Uploaded files are automatically made available to the CGI script +using cgi_import_filename. (See elsewhere for more information.) + +cgi_reset_button value + +cgi_reset_button creates a a reset button. An argument overrides the +default label. For example: + + cgi_reset_button + cgi_reset_button "Not the Default Reset Button" + +cgi_map name cmd +cgi_area args + +These procedures are used to specify client-side image maps. The +first argument of cgi_map is the map name. The last argument is +evaluated to fill the contents of <map></map> tags. cgi_area's +arguments are embedded as arguments in an <area> tag. + +Warning: These two commands will likely be redefined as I get more +familiar with how they are typically used. + +************************************************** +CHECKBOX +************************************************** + +cgi_checkbox name=value + +cgi_checkbox is similar to cgi_radio_button (see above) except that +multiple values can be checked at the same time. As explained +earlier, the variable name must end with "List" in order for it to +group all the values as a list in the resulting CGI script. + +The argument "checked_if_equal=xxx" which indicates that the current +name should be shown selected if its associated value is xxx. This is +handy if you are creating checkboxes by iterating over a list. + +The argument "checked=value" indicates that the checkbox should be +shown selected if the value is a boolean of value true. + +Other arguments are passed on as attributes. + + +************************************************** +TEXTENTRY AND TEXTAREA +************************************************** + +cgi_text name=value + +cgi_text provides a one-line text entry box. It works similarly to +other form elements. (Read "Name-value commands" elsewhere.) +Additional arguments are passed on as attributes. Examples: + + cgi_text Foo + cgi_text Foo= + cgi_text Foo=value2 + cgi_text Foo=value2 size=5 + cgi_text Foo=value2 size=5 maxlength=10 + cgi_text Foo=value2 size=10 maxlength=5 + cgi_text Foo=value2 maxlength=5 + +cgi_textarea name=value + +cgi_textarea provides a multiline text entry box. It works similarly +to other form elements. (Read "Name-value commands" elsewhere.) +Additional arguments are passed on as attributes. + + set value "A really long line so that we can compare the\ + effect of wrap options." + + cgi_textarea Foo + cgi_textarea Foo= + cgi_textarea Foo=$value + cgi_textarea Foo=$value rows=3 + cgi_textarea Foo=$value rows=3 cols=7 + cgi_textarea Foo=$value rows=3 cols=7 wrap=virtual + +************************************************** +SELECT +************************************************** + +cgi_select name cmd + +cgi_select can be used to produce pull-down menus and scrolled lists. +(And depending upon the future of HTML, I may provide better-named +commands to indicate this.) Its behavior is controlled by additional +arguments which are simply the appropriate attributes. + +cgi_select evaluates cmd which typically contains multiple calls to +cgi_option. + +cgi_option string + +cgi_option adds options to cgi_select. By default, the string is +displayed and sent back as the value of the cgi_select variable. The +value can be overridden by an explicit "value=" argument. Additional +options are passed on as attributes, except for "selected_if_equal". + +"selected_if_equal=xxx" indicates that the current option should be +shown selected if the value is equal to xxx. This is useful if you +are generating cgi_options in a loop rather than manually. + +Here are examples: + + # pull-down menu + cgi_select Foo { + cgi_option one selected + cgi_option two + cgi_option many value=hello + } + + # scrolled list, allow multiple selections, show all elements + cgi_select FooList multiple { + cgi_option one selected + cgi_option two selected + cgi_option many + } + + # scrolled list, allow multiple selections, show 2 elements max + cgi_select FooList multiple size=2 { + cgi_option one selected + cgi_option two selected + cgi_option many + } + + # choose "selected" dynamically + # example: list all Tcl command and select "exit" automatically + cgi_select FooList multiple size=5 { + foreach o [info comm] { + cgi_option $o selected_if_equal=exit + } + } + +Note: If both value= and selected_if_equal= appear, the test for +selection is made against the last value string (implicit or explicit) +that appears before the selected_if_equal argument. In other words, +if you want selected_if_equal= to be tested against the explicit +value= argument, put the selected_if_equal= *after* the value=. + +************************************************** +APPLET +************************************************** + +cgi_applet parameters cmd + +cgi_applet produces <applet></applet> tags such as for Java. + +cgi_param name=value + +cgi_param produces <param> tags for passing parameters to applets. + +For example: + + cgi_applet "codebase=../" "code=some.class" width=640 height=480 { + cgi_param parm=value + } + +************************************************** +PLUG-IN +************************************************** + +cgi_embed src widthxheight + +cgi_embed creates an <embed> tag. The first argument is the source. +The second argument is the width and height in the style "WxH". +Optional arguments are passed on to the tag. For example: + + cgi_embed myavi.avi 320x200 autostart=true + +produces: + + <embed src="myavi.avi" width="320" height="200" autostart=true> + +Notice the autostart value is unquoted because autostart is not +specifically defined by the spec. The argument "-quote" causes all +remaining attributes to be url encoded and quoted. For example: + + cgi_embed myavi.avi 320x200 a=b -quote c=d e=f + +produces: + + <embed src="myavi.avi" width="320" height="200" a=b c="d" e="f"> + +************************************************** +MISC +************************************************** + +cgi_hr + +cgi_hr produces horizontal rules. Optional arguments are passed on as +attributes. + +************************************************** +COMMENTS +************************************************** + +cgi_comment stuff + +cgi_comment can comment out anything including blocks of code. + +cgi_html_comment stuff + +cgi_html_comment comments out things in such a way that the comment +appears in the final html itself. + +************************************************** +OUTPUT +************************************************** + +cgi_put string + +cgi_put prints the string with no new terminating newline. This is +simply a shorthand for puts -nonewline. + +cgi_puts + +Many routines in this library send output to the standard output by +default. This is convenient for CGI scripts. However, if you want to +generate multiple files, it is useful to be able to redirect output +dynamically. Output can be redirected by redefining cgi_puts. The +default definition of cgi_puts is: + + proc cgi_puts {args} { + eval puts $args + } + +cgi_puts must allow for an optional -nonewline argument. For example, +here is a definition that writes to a file identified by the global +"fd". + + proc cgi_puts {args} { + global fd + + puts -nonewline $fd [lindex $args end] + if {[llength $args] > 1} { + puts $fd "" + } + } + +cgi_buffer cmd + +cgi_buffer evaluates its argument in such a way that output (through +explicit or implicit calls to cgi_puts) is not produced. Instead, the +output is returned. + +For example, the following cmd generates a link with the hyperlinked +portion being a header and two paragraphs. + + link tag [cgi_buffer { + h3 "Level 3 header" + p "New paragraph" + p "Another paragraph" + }] $URL + +cgi_buffer can be called recursively. + +cgi_buffer_nl string + +By default, cgi_buffer generates newlines at the end of every line in +the style of puts. It is occasionally useful to be able to disable +this - for example, when calling it inside cgi_preformatted. The +newline definition can be changed via cgi_buffer_nl. (There is no +point to redefining cgi_puts since cgi_buffer doesn't use it.) A null +argument suppresses any newline. For example: + + cgi_buffer_nl "" + +cgi_buffer_nl returns the previous definition. + +************************************************** +MAIL +************************************************** + +Rudimentary email support is provided, in part, because it is useful +for trapping errors - if debugging is disabled (i.e., during actual +use) and an error is encountered, errors are emailed to the service +admin. + +The current implementation only permits one email transaction at a +time. + +cgi_mail_addr addr + +cgi_mail_addr defines the email address that mail comes from. Your +email system must allow this, of course. (If your system doesn't +allow it, the request is usually ignored.) + +cgi_mail_start addr + +cgi_mail_start creates a mail message to be delivered the given addr. +cgi_mail_add should be used to provide a subject and body. + +cgi_mail_add string + +cgi_mail_add adds strings to the current mail message. No argument +causes a blank line to be added. + +cgi_mail_end + +cgi_mail_end queues the the current mail message for delivery. + + cgi_mail_start libes@nist.gov + cgi_mail_add "Subject: [cgi_name] request succeeded + cgi_mail_add + cgi_mail_add "Your request has been processed." + cgi_mail_add "Thanks for using [cgi_name]. + cgi_mail_end + +cgi_mail_relay host + +cgi_mail_relay identifies a host to be used for mail relay services. +(This is currently only used when sendmail support is not available.) +If a relay is not defined, email is sent directly to the recipient. + +************************************************** +INITIALIZATION +************************************************** + +cgi_init + +The package initializes itself upon initial loading, however it can be +explicitly initialized by calling cgi_init. This is useful in +environments such as tclhttpd. diff --git a/web/src/cgi.tcl-1.10/example/README b/web/src/cgi.tcl-1.10/example/README new file mode 100644 index 00000000..6bbbb80c --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/README @@ -0,0 +1,77 @@ +This file is cgi.tcl/README. It contains brief descriptions of the +examples in this directory. You are welcome to send me additional +scripts. + +-------------------- +Instructions on running scripts +-------------------- + +The "examples.cgi" script provides a page of clickable links to all +the other example scripts. "frame.cgi" is a framed version - it's not +particularly good looking but it does work and - anyway - I needed a +frame example! + +There are three ways of running these scripts: + +1) Point your browser at http://expect.nist.gov/cgi.tcl + +2) Run them by hand, such as by typing "tclsh scriptname" at the +command line. This is appropriate if you just want to study the raw +HTML output or see how fast they run. + +3) Install them in your own web and run them through your browser. +(If you're on a UNIX host, the "make examples" target in the Makefile +fixes up the #! line of each examples and installs them in a public +demo directory.) You'll want to edit the example.tcl file to redefine +cgi_root appropriately. + +If you run the examples locally (options 2 and 3): + + - In order to get the submit buttons to take you back to your + site (instead of on to my site!), check the cgi_root call in + example.tcl to point back to your site. + + - Some of these examples may do things that are not portable + and therefore may not run on all systems. For example, some + of them call "exec". The "unimail" script assumes the + existence of sendmail through cgi.tcl's built-in mail + support. See the ../install.win file for more info. + +-------------------- +Source files in this directory +-------------------- + + cookie.cgi - demonstrates cookies + + display.cgi - display a CGI script + + error.cgi - demonstrates error handing + + examples.cgi - Provides a page with clickable links to all + these examples. + + form-tour.cgi - demonstrates most form elements (Note that these + don't do anything - they're just for looks.) + + format-tour.cgi - demonstrates many formats, unrelated to forms + + frame.cgi - a friend's home page that demonstrates frames + + kill.cgi - kill runaway CGI processes + + parray.cgi - displays an array (or the environment by default) + + passwd-form.cgi - creates a form for changing a password + passwd.cgi - backend to passwd-form where password is actually changed + Note that this script is an Expect script. + passwd.tcl - common definitions for passwd*.cgi scripts + + upload.cgi - file upload + + vclock.pl - Lincoln Stein's virtual clock from CGI.pm paper + vclock.cgi - Lincoln Stein's virtual clock (but in Tcl) + + visitor.cgi - implements a visitor counter + visitor.cnt - file containing the count + + example.tcl - common definitions for most of the examples diff --git a/web/src/cgi.tcl-1.10/example/cookie.cgi b/web/src/cgi.tcl-1.10/example/cookie.cgi new file mode 100755 index 00000000..ea0709bc --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/cookie.cgi @@ -0,0 +1,45 @@ +#!/depot/path/tclsh + +# This CGI script shows how to create a cookie. + +package require cgi + +cgi_eval { + source example.tcl + + cgi_input + + cgi_http_head { + cgi_content_type text/html + if {0==[catch {cgi_import Name}]} { + cgi_export_cookie Name ;# expires=never + # For a persistent cookie, uncomment the "expires=never" + } else { + catch {cgi_import_cookie Name} + } + } + cgi_head { + cgi_title "Cookie Form Example" + } + cgi_body { + p "This form finds a value from a previous submission of \ + the form either directly or through a cookie." + set Name "" + + if {0==[catch {cgi_import Name}]} { + p "The value was found from the form submission and the cookie + has now been set. Bookmark this form, surf somewhere else + and then return to this page to get the value via the cookie." + } elseif {0==[catch {cgi_import_cookie Name}]} { + p "The value was found from the cookie." + } else { + p "No cookie is currently set. To set a cookie, enter a value + and press return." + } + + cgi_form cookie { + puts "Value: " + cgi_text Name + } + } +} diff --git a/web/src/cgi.tcl-1.10/example/creditcard.cgi b/web/src/cgi.tcl-1.10/example/creditcard.cgi new file mode 100755 index 00000000..a205b452 --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/creditcard.cgi @@ -0,0 +1,137 @@ +#!/depot/path/tclsh + +package require cgi + +cgi_eval { + source example.tcl + + set cardtypes { + "American Express" + "Carte Blanche" + "Diners Card" + "Discover" + "Enroute" + "JCB" + "Mastercard" + "Novus" + "Visa" + } + + # My own version of the LUHN check + proc LUHNFormula {cardnumber} { + if {0==[regexp "(.*)(.)$" $cardnumber dummy cardnumber check]} { + user_error "No card number entered" + } + set evenodd [expr [string length $cardnumber] % 2] + + set sum 0 + foreach digit [split $cardnumber ""] { + incr sum $digit + if {$evenodd} { + incr sum [lindex {0 1 2 3 4 -4 -3 -2 -1 0} $digit] + } + set evenodd [expr !$evenodd] + } + set computed [expr {(10 - ($sum % 10)) % 10}] + if {$computed != $check} { + user_error "Invalid card number. (Failed LUHN test - try changing last digit to $computed.)" + } + } + + # generate digit patterns of length n + proc d {n} { + for {set i 0} {$i < $n} {incr i} { + append buf {[0-9]} + } + return $buf + } + + cgi_input + + cgi_title "Check Credit Card" + + cgi_body { + if {0 == [catch {cgi_import cardtype}]} { + if {[catch {cgi_import cardnumber}]} { + user_error "No card number entered" + } + # Save original version for clearer diagnostics + set originalcardnumber [cgi_quote_html $cardnumber] + + if {[catch {cgi_import expiration}]} { + user_error "You must enter an expiration." + } + if {-1 == [lsearch $cardtypes $cardtype]} { + user_error "Unknown card type: $cardtype" + } + + # Remove any spaces or dashes in card number + regsub -all "\[- ]" $cardnumber "" cardnumber + + # Make sure that only digits are left + if {[regexp "\[^0-9]" $cardnumber invalid]} { + user_error "Invalid character ([cgi_quote_html $invalid]) in credit card number: $originalcardnumber" + } + + if {$cardtype != "Enroute"} { + LUHNFormula $cardnumber + } + + # Verify correct length and prefix for each card type + switch $cardtype { + Visa { + regexp "^4[d 12]([d 3])?$" $cardnumber match + } Mastercard { + regexp "^5\[1-5][d 14]$" $cardnumber match + } "American Express" { + regexp "^3\[47][d 13]$" $cardnumber match + } "Diners Club" { + regexp "^3(0\[0-5]|\[68][d 1])[d 11]$" $cardnumber match + } "Carte Blanche" { + regexp "^3(0\[0-5]|\[68][d 1])[d 11]$" $cardnumber match + } Discover { + regexp "^6011[d 12]$" $cardnumber match + } Enroute { + regexp "^(2014|2149)[d 11]$" $cardnumber match + } JCB { + regexp "^(2131|1800)[d 11]$" $cardnumber match + regexp "^3(088|096|112|158|337|528)[d 12]$" $cardnumber match + } Novus { + if {[string length $cardnumber] == 16} { + set match 1 + } + } + } + + if 0==[info exists match] { + user_error "Invalid card number: $originalcardnumber" + } + h3 "Your card appears to be valid. Thanks!" + return + } + + cgi_form creditcard { + h3 "Select a card type, enter the card number and expiration." + puts "Card type: " + cgi_select cardtype { + foreach t $cardtypes { + cgi_option $t + } + } + puts "[nl]Card number: " + cgi_text cardnumber= + puts "(blanks and dashes are ignored)" + + puts "[nl]Expiration: " + cgi_text expiration= + + br + submit_button "=Confirm purchase" + reset_button + h5 "This script will perform all of the known syntactic + checks for each card type but will not actually contact + a credit bureau. The expiration field is not presently + checked at all." + } + } +} diff --git a/web/src/cgi.tcl-1.10/example/display-in-frame.cgi b/web/src/cgi.tcl-1.10/example/display-in-frame.cgi new file mode 100755 index 00000000..6366957e --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/display-in-frame.cgi @@ -0,0 +1,31 @@ +#!/depot/path/tclsh + +# This is a CGI script that displays the results of other CGI scripts +# in a separate frame. It is only used for a few rare examples such +# as image.cgi + +package require cgi + +cgi_eval { + source example.tcl + + cgi_input + + cgi_head { + set scriptname image.cgi + catch {cgi_import scriptname} + set scriptname [file tail $scriptname] + cgi_title $scriptname + } + cgi_frameset rows=50%,50% { + cgi_frame =$scriptname?header=1 + cgi_frame =$scriptname + } + cgi_noframes { + cgi_h1 "uh oh" + + p "This document is designed to be viewed by a Frames-capable + browser. If you see this message your browser is not + Frames-capable." + } +} diff --git a/web/src/cgi.tcl-1.10/example/display.cgi b/web/src/cgi.tcl-1.10/example/display.cgi new file mode 100755 index 00000000..efadbe05 --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/display.cgi @@ -0,0 +1,44 @@ +#!/depot/path/tclsh + +# This is a CGI script that displays another CGI script +# and massages "source" commands into hyperlinks + +package require cgi + +cgi_eval { + source example.tcl + + cgi_input + + cgi_head { + set scriptname [info script]; # display self by default! + catch {cgi_import scriptname} + + # strip tildes to gracefully handle experimenters + set scriptname [string trimleft $scriptname ~] + + set scriptname [file tail $scriptname] + cgi_title "Source for $scriptname" + } + cgi_body { + # gracefully handle hackers trying to opening directories + switch -- $scriptname . - .. - "" { + h3 "No such file: $scriptname" + return + } + if {[catch {set fid [open $scriptname]}]} { + h3 "No such file: $scriptname" + return + } + cgi_preformatted { + while {-1 != [gets $fid buf]} { + if {[regexp "^(\[ \t]*)source (.*)" $buf ignore space filename]} { + puts "[set space]source [cgi_url $filename [cgi_cgi display scriptname=$filename]]" + } else { + puts [cgi_quote_html $buf] + } + } + } + } +} + diff --git a/web/src/cgi.tcl-1.10/example/download.cgi b/web/src/cgi.tcl-1.10/example/download.cgi new file mode 100755 index 00000000..c82cb3f5 --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/download.cgi @@ -0,0 +1,36 @@ +#!/depot/path/tclsh + +package require cgi + +set msg "Very funny, Scotty. Now beam down my clothes." +set filename "scotty.msg" + +cgi_eval { + source example.tcl + + cgi_input + + if {[catch {cgi_import style}]} { + cgi_title "download example" + body { + cgi_suffix "" + form download.cgi/$filename { + puts "This example demonstrates how to force files to be + downloaded into a separate file via the popup file browser." + br + puts "Download data" + submit_button "style=in window" + submit_button "style=in file using popup file browser" + } + } + } else { + if {[regexp "in window" $style]} { + title "Display data in browser window" + } else { + cgi_http_head { + content_type application/x-download + } + } + puts $msg + } +} diff --git a/web/src/cgi.tcl-1.10/example/error.cgi b/web/src/cgi.tcl-1.10/example/error.cgi new file mode 100755 index 00000000..0b97c99a --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/error.cgi @@ -0,0 +1,31 @@ +#!/depot/path/tclsh + +# This is a CGI script that demonstrates error processing. + +package require cgi + +cgi_eval { + source example.tcl + + cgi_input + + cgi_title "This CGI script contains an intentional error." + + cgi_body { + p "The page that you are now reading is being generated by a + CGI script that contains an intentional error." + + cgi_debug -on + + p "Debugging is enabled, so the error message will be shown in +the browser window (below). Disable this by commenting out the +cgi_debug command and reloading this script." + + cgi_number_list { + cgi_li "List item 1" + cgi_li "List item 2" + cgi_lix "List item 3 - intentionally misspelled" + cgi_li "List item 4" + } + } +} diff --git a/web/src/cgi.tcl-1.10/example/evaljs.cgi b/web/src/cgi.tcl-1.10/example/evaljs.cgi new file mode 100755 index 00000000..ea732e9d --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/evaljs.cgi @@ -0,0 +1,36 @@ +#!/depot/path/tclsh + +# This CGI script uses JavaScript to evaluate an expression. + +package require cgi + +cgi_eval { + source example.tcl + + cgi_head { + title "Using JavaScript to evaluate an expression" + + javascript { + puts { + function compute(f) { + f.result.value = eval(f.expr.value) + } + } + } + noscript { + puts "Sorry - your browser doesn't understand JavaScript." + } + } + + cgi_body { + cgi_form dummy { + cgi_unbreakable { + cgi_button "Evaluate" onClick=compute(this.form) + cgi_text expr=Math.sqrt(2)*10000 + puts "=" + cgi_text result= + } + p "Feel free to enter and evaluate your own JavaScript expression." + } + } +} diff --git a/web/src/cgi.tcl-1.10/example/example.tcl b/web/src/cgi.tcl-1.10/example/example.tcl new file mode 100644 index 00000000..c1246621 --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/example.tcl @@ -0,0 +1,82 @@ +# common definitions for all examples + +# cgi_debug -on + +set NIST_HOST http://www.nist.gov +set MSID_HOST http://www.nist.gov +set EXPECT_HOST http://expect.nist.gov +set EXPECT_ART $EXPECT_HOST/art +set MSID_STAFF $MSID_HOST/msidstaff +set CGITCL $EXPECT_HOST/cgi.tcl +set DATADIR data + +set domainname "unknown" +catch {set domainname [exec domainname]} + +# prevent everyone in the world from sending specious mail to Don! +if {($domainname == "cme.nist.gov") || ([info hostname] == "ats.nist.gov")} { + cgi_admin_mail_addr libes@nist.gov +} + +set TOP target=_top +cgi_link NIST "NIST" $NIST_HOST $TOP +cgi_link Don "Don Libes" $MSID_STAFF/libes $TOP +cgi_link admin "your system administrator" mailto:[cgi_admin_mail_addr] +cgi_link CGITCL "cgi.tcl homepage" $CGITCL $TOP +cgi_link examples "list of examples" [cgi_cgi examples] $TOP +cgi_link realapps "real applications" $CGITCL/realapps.html $TOP +cgi_link Expect "Expect" $EXPECT_HOST $TOP +cgi_link Oratcl "Oratcl" http://www.nyx.net/~tpoindex/tcl.html#Oratcl $TOP + +cgi_imglink logo $EXPECT_ART/cgitcl-powered-feather.gif align=right "alt=powered-by-cgi.tcl logo" +cgi_link logolink [cgi_imglink logo] $CGITCL $TOP + +# Allow for both my development and production environment. And people +# who copy this to their own server and fail to change cgi_root will get +# my production environment! +if {$domainname == "cme.nist.gov"} { + cgi_root "http://www-i.cme.nist.gov/cgi-bin/cgi-tcl-examples" +} else { + cgi_root "http://ats.nist.gov/cgi-bin/cgi.tcl" +} + +proc scriptlink {} { + if {0==[catch {cgi_import framed}]} { + set target "target=script" + } else { + set target "" + } + + cgi_url "the Tcl script" [cgi_cgi display scriptname=[info script]] $target +} + +proc app_body_start {} { + h2 [cgi_title] + puts "See [scriptlink] that created this page." + hr +} + +proc app_body_end {} { + hr; puts "[cgi_link logolink]" + puts "Report problems with this script to [link admin]." + br; puts "CGI script author: [link Don], [link NIST]" + br; puts "Go back to [link CGITCL] or [link examples]." +} + +cgi_body_args bgcolor=#00b0b0 text=#ffffff + +proc user_error {msg} { + h3 "Error: $msg" + cgi_exit +} + +# support for rare examples that must be explicitly framed +proc describe_in_frame {title msg} { + if {0 == [catch {cgi_import header}]} { + cgi_title $title + cgi_body { + p $msg + } + exit + } +} diff --git a/web/src/cgi.tcl-1.10/example/examples.cgi b/web/src/cgi.tcl-1.10/example/examples.cgi new file mode 100755 index 00000000..75afb1e9 --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/examples.cgi @@ -0,0 +1,81 @@ +#!/depot/path/tclsh + +package require cgi + +cgi_eval { + source example.tcl + + input + + title "cgi.tcl examples" + + # use targets if we are framed + if {0==[catch {import framed}]} { + set target "target=script" + } else { + set target "" + } + + # create a hyperlink to run a script + proc run {name} { + url $name.cgi [cgi $name] [uplevel {set target}] + } + + # create hyperlink to show script source + proc display {name} { + url $name.cgi [cgi display scriptname=$name.cgi] [uplevel {set target}] + } + + body bgcolor=#d0a0a0 text=#000000 { + p "These are examples of cgi.tcl, a CGI support library for Tcl + programmers. If you would like to show off what you've + written with cgi.tcl, give me an html-formatted blurb and I'll + add it to a page of [link realapps]. For more information, + visit the [link CGITCL]." + + bullet_list { + li "[run cookie] - Cookie example. Also see [run passwd-form] to see cookies in the context of a real application." + li "[run creditcard] - Check a credit card." + li "[run download] - Demonstrate file downloading. Also see [run upload]." + li "[run echo] - Echo everything - good for debugging forms." + li "[run error] - Error handling example." + li "[run evaljs] - Evaluate an expression using JavaScript." + li "[run examples] - Generate the page you are now reading." + li "[run form-tour] and [display form-tour-result] - Show + many different form elements and the backend to process them." + li "[run format-tour] - Demonstrate many formats." + li "[run frame] - Framed example (of this page)." + li "[url "image.cgi" [cgi display-in-frame [cgi_cgi_set scriptname \ + image.cgi]] $target] - Produce a raw image." + li "[run img] - Examples of images embedded in a page." + li "[run kill] - Allow anyone to kill runaway CGI processes." + li "[display oratcl] - Use [link Oratcl] to query an Oracle database." + li "[run nistguest] - Specialized guestbook" + li "[run parray] - Demonstrate parray (print array elements)." + li "[run passwd-form] and [display passwd] - Form for + changing a password and its backend. Note that this CGI script + is [bold not] setuid because it is written using [link Expect]. + The script also demonstrates a nice use of cookies." + li "[run push] - Demonstrate server-push." + li "[run rm] - Allow anyone to remove old CGI files from /tmp." + li "[run stopwatch] - A stopwatch written as a Tcl applet." + li "[display unimail] - A universal mail backend that mails the + values of any form back to the form owner." + li "[run upload] - Demonstrate file uploading. Also see [run download]." + li "[run utf] - Demonstrate UTF output." + li "[run validate] - Validate input fields using JavaScript." + li "[run vclock] - Lincoln Stein's virtual clock. + This was the big example in his CGI.pm paper. Examine the + source to [eval url [list "his Perl version"] \ + [cgi display scriptname=vclock.pl] $target] or compare them + [url "side by side" [cgi vclock-src-frame] target=script2]." + li "[run visitor] - Example of a visitor counter." + li "[run version] - Show version information." + li "[run vote] - Vote for a quote." + li "[run display] - Display a CGI script with clickable + source commands. Not a particularly interesting application - + just a utility to help demo these other CGI scripts! But it is + written using cgi.tcl so it might as well be listed here." + } + } +} diff --git a/web/src/cgi.tcl-1.10/example/form-tour-result.cgi b/web/src/cgi.tcl-1.10/example/form-tour-result.cgi new file mode 100755 index 00000000..d1278ecf --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/form-tour-result.cgi @@ -0,0 +1,69 @@ +#!/depot/path/tclsh + +# This is a CGI script that shows the result of the form tour. + +package require cgi + +cgi_eval { + source example.tcl + + cgi_input + cgi_title "Form Element Tour Results" + + cgi_body { + h4 "This is a report of variables set by the form tour." + + if {0!=[catch {cgi_import Foo0}]} { + h5 "Error: It appears that you have invoked this script + without going through [cgi_url "the intended form" [cgi_cgi form-tour]]." + cgi_exit + } + + catch { + cgi_import Map.x + cgi_import Map.y + puts "image button coordinates = ${Map.x},${Map.y}[nl]" + } + + catch { + cgi_import Action + puts "submit button Action=$Action[nl]" + br + } + + foreach x {version A B C D} { + catch { + cgi_import $x + puts "radio button \"$x\": [set $x][nl]" + } + } + catch { + cgi_import VegieList + puts "checkbox Vegielist = $VegieList[nl]" + } + for {set i 0} {$i<=6} {incr i} { + set var Foo$i + cgi_import $var + puts "text $var:" + cgi_preformatted { + puts [set $var] + } + } + for {set i 0} {$i<=9} {incr i} { + set var Foo1$i + cgi_import $var + puts "textvar $var:" + cgi_preformatted { + puts [set $var] + } + } + catch { + cgi_import Foo + puts "select pull-down Foo: $Foo[nl]" + } + catch { + cgi_import FooList + puts "select scrolled list FooList: $FooList[nl]" + } + } +} diff --git a/web/src/cgi.tcl-1.10/example/form-tour.cgi b/web/src/cgi.tcl-1.10/example/form-tour.cgi new file mode 100755 index 00000000..7e5e49d5 --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/form-tour.cgi @@ -0,0 +1,123 @@ +#!/depot/path/tclsh + +# This is a CGI script that shows a selection of form elements +# This script doesn't actually DO anything. + +package require cgi + +cgi_eval { + source example.tcl + + cgi_title "A Tour of Form Elements" + + cgi_body { + form form-tour-result { + h4 "Samples of image button" + cgi_put "image as button" + cgi_image_button "=http://www.nist.gov/msidimages/title.gif" + br + cgi_put "image as button (and will return coords)" + cgi_image_button "Map=http://www.nist.gov/public_affairs/gallery/fireseat.jpg" + + h4 "Samples of submit button" + cgi_submit_button + cgi_submit_button ="Submit" + cgi_submit_button "=Submit Form" + cgi_submit_button "Action=Pay Raise" + + h4 "Samples of reset button" + cgi_reset_button + cgi_put "Default Reset Button" + br + cgi_reset_button "Not the Default Reset Button" + cgi_put "Not the Default Reset Button" + + h4 "Samples of radio button" + cgi_radio_button "version=1" + cgi_put "Version 1" + br + cgi_radio_button "version=2" + cgi_put "Version 2" + br + cgi_radio_button "version=3" checked + cgi_put "Version 3" + + br + foreach x {A B C D} { + cgi_radio_button "$x=" checked_if_equal=B + cgi_put "$x" + br + } + + h4 "Samples of checkbox" + cgi_checkbox VegieList=carrot + cgi_put "Carrot" + br + cgi_checkbox VegieList=rutabaga checked + cgi_put "Rutabaga" + br + cgi_checkbox VegieList= + cgi_put "Vegie" + + h4 "Samples of textentry" + set Foo0 "value1" + set Foo1 "value1" + cgi_text Foo0 + br;cgi_text Foo1= + br;cgi_text Foo2=value2 + br;cgi_text Foo3=value2 size=5 + br;cgi_text Foo4=value2 size=5 maxlength=10 + br;cgi_text Foo5=value2 size=10 maxlength=5 + br;cgi_text Foo6=value2 maxlength=5 + + h4 "Samples of textarea" + + set value "A really long line so that we can compare the\ + effect of wrap options." + + set Foo10 "value1" + set Foo11 "value1" + cgi_textarea Foo10 + br;cgi_textarea Foo11= + br;cgi_textarea Foo12=$value + br;cgi_textarea Foo13=$value rows=3 + br;cgi_textarea "Foo14=default wrap" rows=3 cols=7 + br;cgi_textarea Foo15=wrap=off rows=3 cols=7 wrap=off + br;cgi_textarea Foo16=wrap=soft rows=3 cols=7 wrap=soft + br;cgi_textarea Foo17=wrap=hard rows=3 cols=7 wrap=hard + br;cgi_textarea Foo18=wrap=physical rows=3 cols=7 wrap=physical + br;cgi_textarea Foo19=wrap=virtual rows=3 cols=7 wrap=virtual + + h4 "Samples of select as pull-down menu" + cgi_select Foo { + cgi_option one selected + cgi_option two + cgi_option many value=hello + } + + h4 "Samples of select as scrolled list" + cgi_select FooList multiple { + cgi_option one selected + cgi_option two selected + cgi_option many + } + br + cgi_select FooList multiple size=2 { + cgi_option two selected + cgi_option three selected + cgi_option manymore + } + br + # choose "selected" dynamically + cgi_select FooList multiple size=5 { + foreach o [info comm] { + cgi_option $o selected_if_equal=exit + } + } + h4 "Samples of isindex" + } + cgi_isindex + cgi_isindex "prompt=Enter some delicious keywords: " + } +} + diff --git a/web/src/cgi.tcl-1.10/example/format-tour.cgi b/web/src/cgi.tcl-1.10/example/format-tour.cgi new file mode 100755 index 00000000..b399279f --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/format-tour.cgi @@ -0,0 +1,101 @@ +#!/depot/path/tclsh + +# This is a CGI script that shows a selection of format elements + +package require cgi + +cgi_eval { + source example.tcl + + cgi_title "A Tour of HTML Elements" + cgi_body { + + definition_list { + term "term" + term_definition "definition of term" + } + + h4 "menu list" + menu_list { + li item1 + li item2 + } + + h4 "directory list" + directory_list { + li item1 + li item2 + } + + h4 "a list item by itself" + li "item" + + h4 "number list (roman, starting from 4)" + number_list type=i value=4 { + li "first element" + li "second" + li value=9 "third, start numbering from 9" + li type=A "fourth, switch to upper-arabic" + } + + h4 "bullet list" + bullet_list { + p "plain text" + li "plain item" + h4 "nested list (disc, starting from 4)" + bullet_list type=disc value=4 { + li "first element" + li "second" + li type=circle "third, type=circle" + li type=square "fourth, type=square" + li "fifth, should remain square" + } + } + + h4 "Character formatting samples" + cgi_put "[bold bold]\ + [italic italic]\ + [underline underline]\ + [strikeout strikeout]\ + [subscript subscript]\ + [superscript superscript]\ + [typewriter typewriter]\ + [blink blink] + [emphasis emphasis]\ + [strong strong]\ + [cite cite]\ + [sample sample]\ + [keyboard keyboard]\ + [variable variable]\ + [definition definition]\ + [big big]\ + [small small]\ + [font color=#4499cc "color=#4499cc"]\ + " + for {set i 1} {$i<8} {incr i} { + puts [cgi_font size=$i "size=$i"] + } + + h4 "Paragraph formatting samples" + + cgi_h1 h1 + cgi_h2 h2 + cgi_h3 h3 + cgi_h4 h4 + cgi_h5 h5 + cgi_h6 h6 + cgi_h7 "h7 (beyond the spec, what the heck)" + cgi_h6 align=right "right-aligned h6" + cgi_p align=right "right-aligned paragraph" + cgi_put put + cgi_blockquote "blockquote" + cgi_address address + cgi_division { + puts "division" + } + cgi_preformatted { + puts "preformatted" + } + } +} + diff --git a/web/src/cgi.tcl-1.10/example/frame.cgi b/web/src/cgi.tcl-1.10/example/frame.cgi new file mode 100755 index 00000000..f8338b47 --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/frame.cgi @@ -0,0 +1,32 @@ +#!/depot/path/tclsh + +# This is a CGI script that creates some frames. + +package require cgi + +cgi_eval { + source example.tcl + cgi_input + + cgi_title "Frame example" + + # allow URL's of the form ;# frame.cgi?example=.... + # so as to override default + set example examples ;# default is the examples page itself!! + catch {cgi_import example} + + cgi_frameset rows=100,* { + cgi_frame =$CGITCL + cgi_frameset cols=200,* { + cgi_frame =examples.cgi?framed=yes + cgi_frame script=$example.cgi + } + } + cgi_noframes { + cgi_h1 "uh oh" + + p "This document is designed to be viewed by a Frames-capable + browser. If you see this message your browser is not + Frames-capable." + } +} diff --git a/web/src/cgi.tcl-1.10/example/image.cgi b/web/src/cgi.tcl-1.10/example/image.cgi new file mode 100755 index 00000000..e1321523 --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/image.cgi @@ -0,0 +1,29 @@ +#!/depot/path/tclsh +# See description below. + +package require cgi + +cgi_eval { + source example.tcl + cgi_input + + describe_in_frame "raw image" "This CGI script generates a raw + image. The script could be much more complicated - the point is + merely to show the framework. (The picture is of the US National + Prototype Kilogram. It is made of 90% platinum, 10% iridium. It + was assigned to the US in 1889 and is periodically recertified and + traceable to [italic "The Kilogram"] held at + [url "Bureau International des Poids et Mesures" http://www.bipm.fr" $TOP] + in France.)" + + # ignore the junk above this line - the crucial stuff is below + + cgi_content_type "image/jpeg" + + set fh [open $DATADIR/kg.jpg r] + fconfigure stdout -translation binary + fconfigure $fh -translation binary + fcopy $fh stdout + close $fh +} + diff --git a/web/src/cgi.tcl-1.10/example/img.cgi b/web/src/cgi.tcl-1.10/example/img.cgi new file mode 100755 index 00000000..4c84787d --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/img.cgi @@ -0,0 +1,39 @@ +#!/depot/path/tclsh + +# This is a CGI script that shows how to do simple images. + +package require cgi + +cgi_eval { + source example.tcl + + cgi_title "Images" + + set NIST_IMAGES http://www.nist.gov/images + + cgi_imglink ball $NIST_IMAGES/ball.gif alt=ball + cgi_imglink birdies $NIST_IMAGES/brd-ln.gif alt=birdies + cgi_imglink daemon $NIST_IMAGES/bsd_daemon.gif "alt=Kirk McKusick's BSD deamon" + + # use white background because some of these images require it + cgi_body bgcolor=#ffffff text=#00b0b0 { + + p "Here are some birdies:[cgi_imglink birdies]" + p "and here is your basic ball [cgi_imglink ball] and here is + the BSD daemon [cgi_imglink daemon]." + + p "I like using the same picture" + p "[cgi_imglink ball] over" + p "[cgi_imglink ball] and over" + p "[cgi_imglink ball] and over" + p "[cgi_imglink ball] so I use the cgi_imglink command to make it easy." + + proc ball {} {return [cgi_imglink ball]} + + p "[cgi_imglink birdies]" + + p "[ball]I can make it even easier [ball] by making a ball + procedure [ball] which I've just done. [ball] You could + tell, eh? [ball]" + } +} diff --git a/web/src/cgi.tcl-1.10/example/kill.cgi b/web/src/cgi.tcl-1.10/example/kill.cgi new file mode 100755 index 00000000..f3ffe6a3 --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/kill.cgi @@ -0,0 +1,69 @@ +#!/depot/path/tclsh + +package require cgi + +cgi_eval { + source example.tcl + + cgi_input + + cgi_title "Kill runaway CGI processes" + + cgi_body { + if {0==[catch {cgi_import PidList}]} { + catch {cgi_import Refresh;set PidList {}} + cgi_import Sig + h4 "If this were not a demo, the following commands would be executed:" + foreach pid $PidList { + # to undemoize this and allow processes to be killed, + # change h5 to exec and remove the quotes + if {[catch {h5 "kill -$Sig $pid"} msg]} { + h4 "$msg" + } + } + } + + cgi_form kill { + set ps /bin/ps + if {[file exists /usr/ucb/ps]} { + set ps /usr/ucb/ps + } + + set f [open "|$ps -auxww" r] + table border=2 { + table_row { + table_data {puts kill} + table_data {cgi_preformatted {puts [gets $f]}} + } + while {-1 != [gets $f buf]} { + if {[regexp "$argv0" $buf]} continue + if {![regexp "^http" $buf]} continue + table_row { + table_data { + scan $buf "%*s %d" pid + cgi_checkbox PidList=$pid + } + table_data { + cgi_preformatted {puts $buf} + } + } + } + + } + + submit_button "=Send signal to selected processes" + submit_button "Refresh=Refresh listing" + reset_button + + br; radio_button "Sig=TERM" checked; puts "SIGTERM: terminate gracefully" + br; radio_button "Sig=KILL"; puts "SIGKILL: terminate ungracefully" + br; radio_button "Sig=STOP"; puts "SIGSTOP: suspend" + br; radio_button "Sig=CONT"; puts "SIGCONT: continue" + + p "SIGSTOP and SIGCONT are particularly useful if the + processes aren't yours and the owner isn't around to ask. + Suspend them and let the owner decide later whether to + continue or kill them." + } + } +} diff --git a/web/src/cgi.tcl-1.10/example/nistguest b/web/src/cgi.tcl-1.10/example/nistguest new file mode 100644 index 00000000..651efc9a --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/nistguest @@ -0,0 +1,102 @@ +Alabama +{} {} x +Alaska +{} {} {} +Arizona +{} {} {} +Arkansas +{} {} x +California +{} {} {} +Colorado +{} {} x +Connecticut +{} {} x +Delaware +{} {} x +Florida +{} {} x +Georgia +{} {} {} +Hawaii +{} {} {} +Idaho +{} {} {} +Illinois +{} {} {} +Indiana +{} {} x +Iowa +{} {} x +Kansas +{} {} {} +Kentucky +{} {} {} +Louisiana +{} {} {} +Maine +{} {} x +Maryland +{} {} x +Massachusetts +{} {} {} +Michigan +{} {} x +Minnesota +{} {} x +Mississippi +{} {} {} +Missouri +{} {} x +Montana +{} {} {} +Nebraska +{} {} x +Nevada +{} {} {} +New Hampshire +{} {} x +New Jersey +{} {} x +New Mexico +{} {} {} +New York +{} {} x +North Carolina +{} {} x +North Dakota +{} {} {} +Ohio +{} {} {} +Oklahoma +{} {} x +Oregon +{} {} {} +Pennsylvania +{} {} {} +Rhode Island +{} {} {} +South Carolina +{} {} x +South Dakota +{} {} x +Tennessee +{} {} x +Texas +{} {} x +Utah +{} {} x +Vermont +{} {} {} +Virginia +{} {} x +Washington +{} {} x +Washington DC +{} {} {} +West Virginia +{} {} {} +Wisconsin +{} {} x +Wyoming +{} {} {} diff --git a/web/src/cgi.tcl-1.10/example/nistguest.cgi b/web/src/cgi.tcl-1.10/example/nistguest.cgi new file mode 100755 index 00000000..b41d456b --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/nistguest.cgi @@ -0,0 +1,130 @@ +#!/depot/path/tclsh + +package require cgi + +cgi_eval { + source example.tcl + cgi_input + + cgi_title "NIST Guest Book" + + cgi_uid_check http + + set BarURL $EXPECT_ART/pink.gif + + set Q(filename) "$DATADIR/nistguest" + + set statesNeeded {} + + proc poll_read {} { + global Q + + set fid [open $Q(filename) r] + while {-1!=[gets $fid StateFullName]} { + regsub " " $StateFullName "" State + set Q($State) $StateFullName + gets $fid buf + foreach "Q($State,1) Q($State,2) Q($State,3)" $buf {} + lappend Q(statesAll) $State + if {0 == [string compare "" "$Q($State,3)"]} { + lappend Q(statesNeeded) $State + } + } + close $fid + } + + proc poll_write {} { + global Q + + # No file locking or real database handy so we can't guarantee that + # simultaneous votes aren't dropped, but we'll at least avoid + # corruption of the file by working on a private copy. + set tmpfile $Q(filename).[pid] + set fid [open $tmpfile w] + foreach state $Q(statesAll) { + set data [list $Q($state,1) $Q($state,2) $Q($state,3)] + puts $fid $Q($state)\n$data + } + close $fid + exec mv $tmpfile $Q(filename) + } + + cgi_body { + poll_read + + if {0 == [catch {cgi_import State}]} { + if {![info exists Q($State)]} { + user_error "There is no such state: $State" + } + + set Name "" + catch {import Name} + if {0==[string length $Name]} { + user_error "You didn't provide your name." + } + + set Email "" + catch {import Email} + + set Description "" + catch {import Description} + if {0==[string length $Description]} { + user_error "You didn't provide a description." + } + + set data "<Name $Name><Email $Email><Description $Description>" + # simplify poll_read by making each entry a single line + regsub -all \n $data " " data + + if {0 == [string compare "" $Q($State,1)]} { + set Q($State,1) $data + } elseif {0 == [string compare "" $Q($State,2)]} { + set Q($State,2) $data + } else { + set Q($State,3) $data + } + + poll_write + puts "Thanks for your submission!" + + return + } + + form nistguest { + puts "In the spirit of Scriptics' request for Tcl success +stories, our group at NIST is looking for some too. It's time for our +annual report to Congress. So if your state appears in the list below +and you can provide a brief description of how our work has helped +you, we would appreciate hearing from you." + hr + br;puts "If your state does not appear in this list, then we +already have enough entries for your state. Thanks anyway!" + br;puts "State:" + cgi_select State { + foreach state $Q(statesNeeded) { + option "$Q($state)" value=$state + } + } + + br;puts "Full name:" + cgi_text Name= + + br;puts "We probably won't need to contact you; But just in +case, please provide some means of doing so. Email info will remain +confidential - you will NOT be put on any mailing lists." + br;puts "Email:" + cgi_text Email= + puts "(optional)" + + p "Please describe a significant impact (e.g., goals +accomplished, hours/money saved, user expectations met or exceeded) +that NIST's Tcl-based work (Expect, cgi.tcl, APDE, APIB, EXPRESS +server, ...) has had on your organization. A brief paragraph is +fine." + + cgi_textarea Description= rows=10 cols=80 + br + submit_button "=Submit" + } + } +} diff --git a/web/src/cgi.tcl-1.10/example/oratcl.cgi b/web/src/cgi.tcl-1.10/example/oratcl.cgi new file mode 100644 index 00000000..de4a7626 --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/oratcl.cgi @@ -0,0 +1,33 @@ +#!/depot/path/tclsh + +# This is a CGI script that demonstrates how easy it is to use a web +# page to query an Oracle server - using cgi.tcl and Oratcl. +# This example fetches the date from Oracle. + +# I wish we had a public account on our Oracle server so that I could +# allow anyone to run this, but alas we don't. So you'll have to +# trust me that it works. - Don + +package require cgi +package require Oratcl + +cgi_eval { + source example.tcl + + cgi_title "Oracle Example" + cgi_input + + cgi_body { + set env(ORACLE_SID) fork + set env(ORACLE_HOME) /u01/oracle/product/7322 + + set logon [oralogon [import user] [import password]] + set cursor [oraopen $logon] + + orasql $cursor "select SysDate from Dual" + h4 "Oracle's date is [orafetch $cursor]" + + oraclose $cursor + oralogoff $logon + } +} diff --git a/web/src/cgi.tcl-1.10/example/parray.cgi b/web/src/cgi.tcl-1.10/example/parray.cgi new file mode 100755 index 00000000..a4c23316 --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/parray.cgi @@ -0,0 +1,48 @@ +#!/depot/path/tclsh + +# This is a CGI script that displays the environment or another array. + +package require cgi + +cgi_eval { + source example.tcl + + proc arrays {} { + uplevel #0 { + set buf {} + foreach a [info globals] { + if {[array exists $a]} { + lappend buf $a + } + } + return $buf + } + } + + cgi_input + + cgi_title "Display environment or another array" + + cgi_body { + p "This script displays the environment or another array." + if {[catch {cgi_import Name}]} { + set Name env + } + + cgi_form parray { + cgi_select Name { + foreach a [arrays] { + cgi_option $a selected_if_equal=$Name + } + } + cgi_submit_button + } + + global $Name + if {[array exist $Name]} { + cgi_parray $Name + } else { + puts "$Name: no such array" + } + } +} diff --git a/web/src/cgi.tcl-1.10/example/passwd-form.cgi b/web/src/cgi.tcl-1.10/example/passwd-form.cgi new file mode 100755 index 00000000..9d99b716 --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/passwd-form.cgi @@ -0,0 +1,39 @@ +#!/depot/path/tclsh + +# This is a CGI script to present a form in which to change a password. + +# This form doesn't actually have to be written as a CGI script, +# however, it is done so here to demonstrate the procedures described +# in the Tcl '96 paper by Don Libes. You can find this same form +# written as static html in the example directory of the Expect +# package. + +package require cgi + +cgi_eval { + source example.tcl + source passwd.tcl + + cgi_input + + # Use a cookie so that if user has already entered name, don't make them + # do it again. If you dislike cookies, simply remove the next two + # lines - cookie use here is simply a convenience for users. + set login "" + catch {cgi_import_cookie login} + + cgi_title "Change your login password" + cgi_body { + cgi_form passwd { + put "Username: "; cgi_text login size=16 + password "Old" old + password "New" new1 + password "New" new2 + + p "(The new password must be entered twice to avoid typos.)" + + cgi_submit_button "=Change password" + cgi_reset_button + } + } +} diff --git a/web/src/cgi.tcl-1.10/example/passwd.cgi b/web/src/cgi.tcl-1.10/example/passwd.cgi new file mode 100755 index 00000000..85c18174 --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/passwd.cgi @@ -0,0 +1,119 @@ +#!/depot/path/expect -- + +# This is a CGI script to process requests created by the accompanying +# passwd.html form. This script is pretty basic, although it is +# reasonably robust. (Purposely intent users can make the script bomb +# by mocking up their own HTML form, however they can't expose or steal +# passwords or otherwise open any security holes.) This script doesn't +# need any special permissions or ownership. +# +# With a little more code, the script can do much more exotic things - +# for example, you could have the script: +# +# - telnet to another host first (useful if you run CGI scripts on a +# firewall), or +# +# - change passwords on multiple password server hosts, or +# +# - verify that passwords aren't in the dictionary, or +# +# - verify that passwords are at least 8 chars long and have at least 2 +# digits, 2 uppercase, 2 lowercase, or whatever restrictions you like, +# or +# +# - allow short passwords by responding appropriately to passwd +# +# and so on. Have fun! +# +# Don Libes, NIST + +package require cgi + +cgi_eval { + source example.tcl + source passwd.tcl + + cgi_input + + # Save username as cookie (see comment in passwd-form script) so that the + # next time users load the form, their username will already be filled in. + # If cookies bother you, simply remove this entire cgi_http_head command. + cgi_http_head { + cgi_content_type text/html + if {0==[catch {cgi_import login}]} { + cgi_export_cookie login expires=never + } + } + + cgi_title "Password Change Acknowledgment" + cgi_body { + if {(![info exists login]) + || [catch {cgi_import old}] + || [catch {cgi_import new1}] + || [catch {cgi_import new2}]} { + errormsg "This page has been called with input missing. Please \ + visit this form by filling out the password change \ + request form." + return + } + + # Prevent user from sneaking in commands (albeit under their own uid). + if {[regexp "\[^a-zA-Z0-9]" $login char]} { + errormsg "Illegal character ($char) in username." + return + } + + log_user 0 + + # Need to su first to get around passwd's requirement that + # passwd cannot be run by a totally unrelated user. Seems + # rather pointless since it's so easy to satisfy, eh? + + # Change following line appropriately for your site. + # (We use yppasswd, but you might use something else.) + spawn /bin/su $login -c "/bin/yppasswd $login" + # This fails on SunOS 4.1.3 (passwd says "you don't have a + # login name") so run on (or telnet first to) host running + # SunOS 4.1.4 or later. + + expect { + -re "Unknown (login|id):" { + errormsg "unknown user: $login" + return + } default { + errormsg "$expect_out(buffer)" + return + } "Password:" + } + send "$old\r" + expect { + "unknown user" { + errormsg "unknown user: $login" + return + } "Sorry" { + errormsg "Old password incorrect" + return + } default { + errormsg "$expect_out(buffer)" + return + } "Old password:" + } + send "$old\r" + expect "New password:" + send "$new1\r" + expect "New password:" + send "$new2\r" + expect -re (.+)\r\n { + set error $expect_out(1,string) + } + close + wait + + if {[info exists error]} { + errormsg "$error" + } else { + successmsg "Password changed successfully." + } + } +} + diff --git a/web/src/cgi.tcl-1.10/example/passwd.tcl b/web/src/cgi.tcl-1.10/example/passwd.tcl new file mode 100644 index 00000000..31de1e17 --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/passwd.tcl @@ -0,0 +1,10 @@ +# common definitions for all password-related pages + +proc password {prompt varname} { + br + put "$prompt password: " + cgi_text $varname= type=password size=16 +} + +proc successmsg {s} {h3 "$s"} +proc errormsg {s} {h3 "Error: $s"} diff --git a/web/src/cgi.tcl-1.10/example/push.cgi b/web/src/cgi.tcl-1.10/example/push.cgi new file mode 100755 index 00000000..75aeb98c --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/push.cgi @@ -0,0 +1,37 @@ +#!/depot/path/tclsh + +package require cgi + +cgi_eval { + source example.tcl + + set boundary "ThisRandomString" + + cgi_http_head { + cgi_content_type "multipart/x-mixed-replace;boundary=$boundary" + + puts \n--$boundary + cgi_content_type + } + + cgi_title "Multipart example - 1st page" + cgi_body { + h4 "This is an example of [italic server-push] as implemented + by the multipart MIME type. In contrast with client-pull, push + leaves the connection open and the CGI script remains in control + as to send more information. The additional information can + be anything - this example demonstrates an entire page being + replaced." + } + + puts \n--$boundary + after 5000 + + cgi_content_type + + cgi_title "Multipart example - 2nd page" + cgi_body { + h4 "This page replaced the previous page with no action on the + client side." + } +} diff --git a/web/src/cgi.tcl-1.10/example/rm.cgi b/web/src/cgi.tcl-1.10/example/rm.cgi new file mode 100644 index 00000000..bc9534af --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/rm.cgi @@ -0,0 +1,59 @@ +#!/depot/path/tclsh + +package require cgi + +cgi_eval { + source example.tcl + + cgi_input + + cgi_title "Remove old CGI files from /tmp" + + cgi_body { + if {0==[catch {cgi_import FileList}]} { + catch {cgi_import Refresh;set FileList {}} + h4 "If this were not a demo, the following commands would have been executed:" + foreach File $FileList { + # prevent deletion of this dir or anything outside it + set File [file tail $File] + switch $File . - .. - "" { + h3 "Illegal filename: $File" + continue + } + + # to undemoize this and allow files to be killed, + # remove h5 and quotes + if {[catch {h5 "file delete -force /tmp/$File"} msg]} { + h4 "$msg" + } + } + } + + cgi_form rm { + set f [open "|/bin/ls -Alt /tmp" r] + table border=2 { + table_row { + table_data {puts "rm -rf"} + table_data {cgi_preformatted {puts "permissions ln owner group size date filename"}} + } + while {-1 != [gets $f buf]} { + if {![regexp " http " $buf]} continue + table_row { + table_data { + regexp ".* (\[^ ]+)$" $buf dummy File + cgi_checkbox FileList=$File + } + table_data { + cgi_preformatted {puts $buf} + } + } + } + + } + + submit_button "=Removed selected files" + submit_button "Refresh=Refresh listing" + reset_button + } + } +} diff --git a/web/src/cgi.tcl-1.10/example/stopwatch.cgi b/web/src/cgi.tcl-1.10/example/stopwatch.cgi new file mode 100755 index 00000000..4fb4f8c3 --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/stopwatch.cgi @@ -0,0 +1,64 @@ +#!/depot/path/tclsh + +# This is a CGI script that demonstrates a simple Tcl applet + +package require cgi + +source example.tcl + +set srcdir http://www.nist.gov/mel/div826/src/stopwatch +set plugins http://www.sunlabs.com/research/tcl/plugin + +cgi_link source "source" $srcdir/stopwatch.tcl.html" +cgi_link gz "complete distribution" $srcdir/stopwatch.tar.gz +cgi_link moreplugins "More info on Tcl plugins" $plugins +cgi_link homepage "homepage" $EXPECT_HOST/stopwatch + +cgi_eval { + + cgi_input + + cgi_head { + cgi_title "Stopwatch implemented via Tcl applet" + } + cgi_body { + h3 "Description" + + p "This tclet provides a stopwatch. I wrote it to help me + time talks and individual slides within a talk. Stopwatch can + also be run as a Tk script outside the browser - which is the + way I normally use it. If you want to use it outside the browser, grab the distribution from the stopwatch [cgi_link homepage]." + + h3 "Directions" + + p {Press "start" to start the stopwatch and "stop" to stop it. + "zero" resets the time. You can also edit/cut/paste the time + by hand and set it to any valid time. A second timer is + provided as well. It works just like a normal lap timer.} + + cgi_embed http://www.nist.gov/mel/div826/src/stopwatch/stopwatch.tcl \ + 450x105 + + p "This is the first Tclet I've ever written. Actually, I + just took an existing Tk script I had already written and + wrapped it in an HTML page. It took about 30 minutes to write + the original Tk script (about 80 lines) and 1 minute to embed + it in an HTML page." + + p "Stopwatch is not intended for timing less than one second + or longer than 99 hours. It's easy to make make it show more + but the code doesn't do it as distributed and I have no + interest in adding more and more features until it reads mail. + It's just a nice, convenient stopwatch." + + h3 "For more info" + + cgi_bullet_list { + cgi_li "Stopwatch [cgi_link homepage]." + cgi_li "Stopwatch [cgi_link source] and [cgi_link gz]." + cgi_li "[cgi_link moreplugins]." + } + } +} + + diff --git a/web/src/cgi.tcl-1.10/example/unimail.cgi b/web/src/cgi.tcl-1.10/example/unimail.cgi new file mode 100755 index 00000000..9fca7cb0 --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/unimail.cgi @@ -0,0 +1,58 @@ +#!/depot/path/tclsh + +# This script is a universal mail backend. It's handy for creating +# forms that simply email all their elements to someone else. You +# wouldn't use it in a fancy application, but non-programmers like it +# since they can use it to process forms with no CGI scripting at all. +# +# To use, make your form look something like this: +# +# <form action="http://ats.nist.gov/cgi-bin/cgi.tcl/unimail.cgi" method=post> +# <input type=hidden name=mailto value="YOUR EMAIL ADDRESS HERE"> +# ...rest of your form... +# </form> +# +# Note: You can use our action URL to try this out, but please switch +# to using your own local unimail script for production use. Thanks! +# +# Author: Don Libes, NIST + +package require cgi + +cgi_eval { + source example.tcl + + cgi_title "Universal mail backend" + + cgi_body { + if {[catch cgi_input errormsg]} { + h2 "Form Error" + p "An error was detected in the form. Please send the + following diagnostics to the form author." + cgi_preformatted {puts $errormsg} + return + } + if {[catch {cgi_import mailto}]} { + h2 "Error: No mailto variable in form." + return + } + if {![info exists env(HTTP_REFERER)]} { + set env(HTTP_REFERER) "unknown" + } + cgi_mail_start $mailto + cgi_mail_add "Subject: submission from web form: $env(HTTP_REFERER)" + cgi_mail_add + catch {cgi_mail_add "Remote addr: $env(REMOTE_ADDR)"} + catch {cgi_mail_add "Remote host: $env(REMOTE_HOST)"} + + foreach item [cgi_import_list] { + cgi_mail_add "$item: [cgi_import $item]" + } + cgi_mail_end + + if {[catch {cgi_import thanks}]} { + set thanks [cgi_buffer {h2 "Thanks for your submission."}] + } + cgi_put $thanks + } +} diff --git a/web/src/cgi.tcl-1.10/example/upload.cgi b/web/src/cgi.tcl-1.10/example/upload.cgi new file mode 100755 index 00000000..9841aa97 --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/upload.cgi @@ -0,0 +1,59 @@ +#!/depot/path/tclsh + +# This is a CGI script that demonstrates file uploading. + +package require cgi + +cgi_eval { + source example.tcl + + proc showfile {v} { + catch { + set server [cgi_import_file -server $v] + set client [cgi_import_file -client $v] + set type [cgi_import_file -type $v] + if {[string length $client]} { + h4 "Uploaded: $client" + if {0 != [string compare $type ""]} { + h4 "Content-type: $type" + } + cgi_import showList + foreach show $showList { + switch $show { + "od -c" - "cat" { + h5 "Contents shown using $show" + cgi_preformatted {puts [eval exec $show [list $server]]} + } + } + } + } + exec /bin/rm -f $server + } + } + + cgi_input + + cgi_head { + cgi_title "File upload demo" + } + cgi_body { + if {[info tcl] < 8.1} { + h4 "Warning: This script can not perform binary uploads because the server is running a pre-8.1 Tcl ([info tcl])." + } + + showfile file1 + showfile file2 + + cgi_form upload enctype=multipart/form-data { + p "Select up to two files to upload" + cgi_file_button file1; br + cgi_file_button file2; br + checkbox "showList=cat" checked; + put "show contents using cat" ;br + checkbox "showList=od -c" + put "show contents using od -c" ;br + cgi_submit_button =Upload + } + } +} + diff --git a/web/src/cgi.tcl-1.10/example/utf.cgi b/web/src/cgi.tcl-1.10/example/utf.cgi new file mode 100644 index 00000000..1a5a1243 --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/utf.cgi @@ -0,0 +1,17 @@ +#!/local/bin/tclsh + +# Test UTF encoding + +package require cgi + +cgi_eval { + source example.tcl + + cgi_title "Study utf encoding" + cgi_html { + cgi_body { + p "I'm going to be living on the Straüße." + } + } +} + diff --git a/web/src/cgi.tcl-1.10/example/validate.cgi b/web/src/cgi.tcl-1.10/example/validate.cgi new file mode 100755 index 00000000..c104b7b5 --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/validate.cgi @@ -0,0 +1,76 @@ +#!/depot/path/tclsh + +# This CGI script uses JavaScript to validate a form before submission. + +package require cgi + +cgi_eval { + source example.tcl + + cgi_input + + cgi_head { + title "Using JavaScript to validate a form before submission" + + javascript { + puts { + function odd(num) { + if (num.value % 2 == 0) { + alert("Please enter an odd number!") + num.value = "" + return false + } + return true + } + } + } + noscript { + puts "Sorry - your browser doesn't understand JavaScript." + } + } + + set rownum 0 + proc row {msg {event {}}} { + global rownum + + incr rownum + table_row { + table_data nowrap { + put "Odd number: " + text num$rownum= size=4 $event + } + table_data { + puts $msg + } + } + } + + cgi_body { + set more "" + if {0 == [catch {import num3}]} { + set count [scan $num3 %d num] + if {($count != 1) || ($num % 2 == 0)} { + p "Hey, you didn't enter an odd number!" + } else { + p "Thanks for entering odd numbers!" + set more " more" + } + } + + puts "Please enter$more odd numbers - thanks!" + + cgi_form validate "onSubmit=return odd(this.num2)" { + table { + row "This number will be validated when it is entered." onChange=odd(this.form.num1) + row "This number will be validated when the form is submitted." + row "This number will be validated after the form is submitted." + } + submit_button =Submit + } + + h5 "Note: JavaScript validation should always be accompanied + by validation in the backend (CGI script) since browsers + cannot be relied upon to have JavaScript enabled (or supported + in the first place). Sigh." + } +} diff --git a/web/src/cgi.tcl-1.10/example/vclock-src-frame.cgi b/web/src/cgi.tcl-1.10/example/vclock-src-frame.cgi new file mode 100755 index 00000000..37cd6d4b --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/vclock-src-frame.cgi @@ -0,0 +1,23 @@ +#!/depot/path/tclsh + +# This CGI script displays the Tcl and Perl vclock source side by side. + +package require cgi + +cgi_eval { + source example.tcl + + cgi_title "Comparison of vclock source" + + cgi_frameset cols=50%,* { + cgi_frame =[cgi_cgi display scriptname=vclock.cgi] + cgi_frame =[cgi_cgi display scriptname=vclock.pl] + } + cgi_noframes { + cgi_h1 "uh oh" + + p "This document is designed to be viewed by a Frames-capable + browser. If you see this message your browser is not + Frames-capable." + } +} diff --git a/web/src/cgi.tcl-1.10/example/vclock.cgi b/web/src/cgi.tcl-1.10/example/vclock.cgi new file mode 100755 index 00000000..4b925b9f --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/vclock.cgi @@ -0,0 +1,73 @@ +#!/depot/path/tclsh + +# This script implements the "Virtual Clock" used as the example in the +# paper describing CGI.pm, a perl module for generating CGI. +# Stein, L., "CGI.pm: A Perl Module for Creating Dynamic HTML Documents +# with CGI Scripts", SANS 96, May '96. + +# Do you think it is more readable than the other version? +# (If you remove the comments and blank lines, it's exactly +# the same number of lines.) See other comments after script. - Don + +package require cgi + +cgi_eval { + source example.tcl + + cgi_input + + set format "" + if {[llength [cgi_import_list]]} { + if 0==[catch {cgi_import time}] { + append format [expr {[cgi_import type] == "12-hour"?"%r ":"%T "}] + } + catch {cgi_import day; append format "%A "} + catch {cgi_import month; append format "%B "} + catch {cgi_import day-of-month; append format "%d "} + catch {cgi_import year; append format "%Y "} + } else { + append format "%r %A %B %d %Y" + } + + set time [clock format [clock seconds] -format $format] + + cgi_title "Virtual Clock" + + cgi_body { + puts "At the tone, the time will be [strong $time]" + hr + h2 "Set Clock Format" + + cgi_form vclock { + puts "Show: " + foreach x {time day month day-of-month year} { + cgi_checkbox $x checked + put $x + } + br + puts "Time style: " + cgi_radio_button type=12-hour checked;put "12-hour" + cgi_radio_button type=24-hour ;put "24-hour" + br + cgi_reset_button + cgi_submit_button =Set + } + } +} + +# Notes: + +# Time/date generation is built-in to Tcl. Thus, no extra processes +# are necessary and the result is portable. In contrast, CGI.pm +# only runs on UNIX. + +# Displaying checkboxes side by side the way that CGI.pm does by +# default is awful. The problem is that with enough buttons, it's not +# immediately clear if the button goes with the label on the right or +# left. So cgi.tcl does not supply a proc to generate such a +# grouping. I've followed CGI.pm's style here only to show that it's +# trivial to get the same affect, but the formatting in any real form +# is more wisely left to the user. + +# Footer generation (<hr><address>... at end of CGI.pm) is replaced +# by "source example.tcl". Both take one line. diff --git a/web/src/cgi.tcl-1.10/example/vclock.pl b/web/src/cgi.tcl-1.10/example/vclock.pl new file mode 100644 index 00000000..0605f0c7 --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/vclock.pl @@ -0,0 +1,59 @@ +#!/usr/local/bin/perl + +# This script is the "Virtual Clock" example in the seminal +# paper describing CGI.pm, a perl module for generating CGI. +# Stein, L., "CGI.pm: A Perl Module for Creating Dynamic HTML Documents +# with CGI Scripts", SANS 96, May '96. + +# Do you think it is more readable than the other version? +# (If you remove the comments and blank lines, it's exactly +# the same number of lines.) - Don + +use CGI; +$q = new CGI; + +if ($q->param) { + if ($q->param('time')) { + $format = ($q->param('type') eq '12-hour') ? '%r ' : '%T'; + } + + $format .= '%A ' if $q->param('day'); + $format .= '%B ' if $q->param('month'); + $format .= '%d ' if $q->param('day-of-month'); + $format .= '%Y ' if $q->param('year'); +} else { + $format = '%r %A %B %d %Y'; +} + +$time = `date '+$format'`; + +# print the HTTP header and the HTML document +print $q->header; +print $q->start_html('Virtual Clock'); +print <<END; +<H1>Virtual Clock</H1> +At the tone, the time will be <STRONG>$time</STRONG>. +END + +print <<END; +<HR> +<H2>Set Clock Format</H2> +END + +# Create the clock settings form +print $q->start_form; +print "Show: "; +print $q->checkbox(-name->'time',-checked=>1); +print $q->checkbox(-name->'day',-checked=>1); +print $q->checkbox(-name->'month',-checked=>1); +print $q->checkbox(-name->'day-of-month',-checked=>1); +print $q->checkbox(-name->'year',-checked=>1); +print "<P>Time style:"; +print $q->radio_group(-name=>'type', + -values=>['12-hour','24-hour']),"<P>"; +print $q->reset(-name=>'Reset'), + $q->submit(-name=>'Set'); +print $q->end_form; + +print '<HR><ADDRESS>webmaster@ferrets.com</ADDRESS>' +print $q->end_html; diff --git a/web/src/cgi.tcl-1.10/example/version.cgi b/web/src/cgi.tcl-1.10/example/version.cgi new file mode 100644 index 00000000..b266acfb --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/version.cgi @@ -0,0 +1,30 @@ +#!/depot/path/tclsh + +# This is a CGI script that displays some version information that I +# find useful for debugging. + +set v [package require cgi] + +proc row {var val} { + table_row { + td $var + td $val + } +} + +cgi_eval { + source example.tcl + + title "Version info" + + cgi_body { + table border=2 { + row "cgi.tcl" $v + row "Tcl" [info patchlevel] + row "uname -a" [exec uname -a] + catch {row "SERVER_SOFTWARE" $env(SERVER_SOFTWARE)} + catch {row "HTTP_USER_AGENT" $env(HTTP_USER_AGENT)} + catch {row "SERVER_PROTOCOL" $env(SERVER_PROTOCOL)} + } + } +} diff --git a/web/src/cgi.tcl-1.10/example/visitor.cgi b/web/src/cgi.tcl-1.10/example/visitor.cgi new file mode 100755 index 00000000..ee73922e --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/visitor.cgi @@ -0,0 +1,30 @@ +#!/depot/path/tclsh + +package require cgi + +cgi_eval { + source example.tcl + + cgi_title "Visitor count example" + + cgi_body { + cgi_put "This page demonstrates how easy it is to do visitor counts." + + cgi_uid_check http + + cgi_form visitor { + set cfname "$DATADIR/visitor.cnt" + + if {[catch {set fid [open $cfname r+]} errormsg]} { + h4 "Couldn't open $cfname to maintain visitor count: $errormsg" + return + } + gets $fid count + seek $fid 0 start + puts $fid [incr count] + close $fid + h4 "You are visitor $count. Revisit soon!" + cgi_submit_button "=Revisit" + } + } +} diff --git a/web/src/cgi.tcl-1.10/example/visitor.cnt b/web/src/cgi.tcl-1.10/example/visitor.cnt new file mode 100755 index 00000000..5595fa46 --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/visitor.cnt @@ -0,0 +1 @@ +95 diff --git a/web/src/cgi.tcl-1.10/example/vote.cgi b/web/src/cgi.tcl-1.10/example/vote.cgi new file mode 100755 index 00000000..6d06b977 --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/vote.cgi @@ -0,0 +1,190 @@ +#!/depot/path/tclsh + +package require cgi + +cgi_eval { + source example.tcl + cgi_input + + cgi_title "Vote for a t-shirt design!" + + cgi_uid_check http + + set BarURL $EXPECT_ART/pink.gif + + set Q(filename) "$DATADIR/vote.cnt" + + proc votes_read {} { + global Q + + set Q(Max) 0 + set Q(Votes) 0 + set Q(Indices) "" + + set fid [open $Q(filename) r] + while {-1!=[gets $fid i]} { + gets $fid buf + foreach "Q(Votes,$i) Q(Entry,$i) Q(Name,$i) Q(Email,$i)" $buf {} + lappend Q(Indices) $i + set Q(Unvotable,$i) [catch {incr Q(Votes) $Q(Votes,$i)}] + set Q(Max) $i + } + close $fid + } + + proc votes_write {} { + global Q + + # No file locking (or real database) handy so we can't guarantee that + # simultaneous votes aren't dropped, but we'll at least avoid + # corruption of the vote file by working on a private copy. + set tmpfile $Q(filename).[pid] + set fid [open $tmpfile w] + foreach i $Q(Indices) { + set data [list $Q(Votes,$i) $Q(Entry,$i) $Q(Name,$i) $Q(Email,$i)] + # simplify votes_read by making each entry a single line + regsub -all \n $data <br> data + puts $fid $i\n$data + } + close $fid + exec mv $tmpfile $Q(filename) + } + + proc vote_other_show {} { + global Q + + h3 "Other suggestions" + table border=2 { + table_row { + th width=300 "Entry" + th width=300 "Judge's Comments" + } + foreach i $Q(Indices) { + if {!$Q(Unvotable,$i)} continue + table_row { + td width=300 "$Q(Entry,$i)" + td width=300 "$Q(Votes,$i)" + } + } + } + } + + + cgi_body { + votes_read + + if {[regexp "Vote(\[0-9]+)" [cgi_import_list] dummy i]} { + if {[catch {incr Q(Votes,$i)}]} { + user_error "There is no such entry to vote for." + } + incr Q(Votes) + votes_write + + h3 "Thanks for voting! See you at the next Tcl conference!" + set ShowVotes 1 + } + catch {cgi_import ShowVotes} + if {[info exists ShowVotes]} { + table border=2 { + table_row { + th width=300 "Entry" + th "Votes" + th width=140 "Percent" ;# 100 + room for pct + } + foreach i $Q(Indices) { + if {!$Q(Unvotable,$i)} { + table_row { + td width=300 "$Q(Entry,$i)" + td align=right "$Q(Votes,$i)" + table_data width=140 { + table { + table_row { + set pct [expr 100*$Q(Votes,$i)/$Q(Votes)] + # avoid 0-width Netscape bug + set pct_bar [expr $pct==0?1:$pct] + td [img $BarURL align=left width=$pct_bar height=15] + td $pct + } + } + } + } + } + } + } + form vote { + submit_button "=Submit entry or vote" + submit_button "ShowVotes=Show votes" + } + vote_other_show + return + } + + if 0==[catch {import Entry}] { + if {[string length $Entry] == 0} { + user_error "No entry found." + } + if {[string length $Entry] > 500} { + user_error "Your entry is too long. Keep it under 500 characters!" + } + set Name "" + catch {import Name} + if 0==[string length $Name] { + user_error "You must supply your name. How are we going to know who you are if you win?" + } + set Email "" + catch {import Email} + if 0==[string length $Email] { + user_error "You must supply your email. How are we going to contact you if you win?" + } + + set i [incr Q(Max)] + set Q(Entry,$i) $Entry + set Q(Name,$i) $Name + set Q(Email,$i) $Email + set Q(Votes,$i) 1 + lappend Q(Indices) $i + + votes_write + + h3 "Thanks for your new entry!" + p "No need to go back and vote for it - a vote has already + been recorded for you." + form vote { + submit_button "=Submit another entry or vote" + submit_button "ShowVotes=Show votes" + } + return + } + + p "Vote for what will go on the next Tcl conference t-shirt! (Feel free to vote for several entries.)" + + cgi_form vote { + table border=2 { + foreach i $Q(Indices) { + if {$Q(Unvotable,$i)} continue + table_row { + table_data { + cgi_submit_button Vote$i=Vote + } + td "$Q(Entry,$i)" + } + } + } + br + cgi_submit_button "ShowVotes=Just show me the votes" + hr + p "The author of the winning entry gets fame and glory (and a free t-shirt)! Submit a new entry:" + cgi_text Entry= size=80 + p "Entries may use embedded HTML. Images or concepts are fine - for artwork, we have the same artist who did the [url "'96 conference shirt" $MSID_STAFF/libes/t.html]). The [url judges mailto:tclchairs@usenix.org] reserve the right to delete entries. (Do us a favor and use common sense and good taste!)" + puts "Name: " + cgi_text Name= + br + puts "Email: " + cgi_text Email= + br + cgi_submit_button "=Submit new entry" + + vote_other_show + } + } +} diff --git a/web/src/cgi.tcl-1.10/example/vote.cnt b/web/src/cgi.tcl-1.10/example/vote.cnt new file mode 100644 index 00000000..73bc9061 --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/vote.cnt @@ -0,0 +1,30 @@ +1 +179 {Tcl/Tk: The best-kept secret in the software industry} {Michael McLennan} mmc +2 +{it's got potential, needs more work} {Tcl/Tk: Saving the world one proc at a time} {Michael McLennan} mmc +3 +24 {Tcl/Tk: Programmers by day, heros by the end of the quarter} {Michael McLennan} mmc +4 +39 {Tcl/Tk: The struggle between good and eval} {Michael McLennan} mmc +6 +{already dated} {I love Tcl...but <i>puleeez</i> don't call me Elmo!} {mark pernal} mpernal@sprintmail.com +7 +{surely we have more imagination?} spec-TCL-ular {Joerg Reiberg} reiberg@uni-muenster.de +8 +48 {Tcl/Tk: Less Code, More Results} {Bob Jackson} jackson@stsci.edu +9 +{committed alright} {True Committed Lover} {Stephan Uyttebroeck} stephan@frontierd.com +12 +{may we suggest you invest five minutes reading the manual...} {Tcl/Tk: Welcome to string quoting hell!} {Harry Bovik} bovik+junk@cs.cmu.edu +13 +{We'll make up a special one-of-a-kind t-shirt for you, ok?} {I'd rather be hacking Perl.} psu psu@jprc.com +15 +{has potential but needs more work} {Tcl/Tk: A Rabid Prototyping Language} {Ralph Melton} ralph@cs.cmu.edu +16 +{the important thing is, you were using it!} {Tcl/Tk: If at first you don't succeed, you must have been using it} {Dushyanth Narayanan} bumba=roc_tcltk@cs.cmu.edu +17 +{the Howard Stern / People Magazine version} {perl: the angry drunken scripting language} {John Prevost} visigoth+www@cs.cmu.edu +18 +{already taken by Perl, shucks} {Perl: a fast and powerful tool for creating completely inconsistent, incoherent, and unmaintainable code.} {Don} don@libes.com +19 +{ok, enough Perl bashing!} {Perl: an awesome collection of special cases, side-effects, neato punctuation, and enough ambiguity to make a Ouija board blush.} {Don} don@libes.com diff --git a/web/src/cgi.tcl-1.10/fixline1 b/web/src/cgi.tcl-1.10/fixline1 new file mode 100755 index 00000000..1cb57972 --- /dev/null +++ b/web/src/cgi.tcl-1.10/fixline1 @@ -0,0 +1,13 @@ +#!/depot/path/expect -- +# Synopsis: fixline1 newpath < input > output +# Author: Don Libes + +# Description: change first line of script to reflect new binary +# try to match any of the following first lines +#!expect ... +#!../expect ... +#!expectk ... +#!foo/bar/expectk ... +# +regsub "^#!(.*/)*(.*)" [gets stdin] "#!$argv/\\2" line1 +puts -nonewline "$line1\n[read stdin]" diff --git a/web/src/cgi.tcl-1.10/install-sh b/web/src/cgi.tcl-1.10/install-sh new file mode 100755 index 00000000..89fc9b09 --- /dev/null +++ b/web/src/cgi.tcl-1.10/install-sh @@ -0,0 +1,238 @@ +#! /bin/sh +# +# install - install a program, script, or datafile +# This comes from X11R5. +# +# Calling this script install-sh is preferred over install.sh, to prevent +# `make' implicit rules from creating a file called install from it +# when there is no Makefile. +# +# This script is compatible with the BSD install script, but was written +# from scratch. +# + + +# set DOITPROG to echo to test this script + +# Don't use :- since 4.3BSD and earlier shells don't like it. +doit="${DOITPROG-}" + + +# put in absolute paths if you don't have them in your path; or use env. vars. + +mvprog="${MVPROG-mv}" +cpprog="${CPPROG-cp}" +chmodprog="${CHMODPROG-chmod}" +chownprog="${CHOWNPROG-chown}" +chgrpprog="${CHGRPPROG-chgrp}" +stripprog="${STRIPPROG-strip}" +rmprog="${RMPROG-rm}" +mkdirprog="${MKDIRPROG-mkdir}" + +tranformbasename="" +transform_arg="" +instcmd="$mvprog" +chmodcmd="$chmodprog 0755" +chowncmd="" +chgrpcmd="" +stripcmd="" +rmcmd="$rmprog -f" +mvcmd="$mvprog" +src="" +dst="" +dir_arg="" + +while [ x"$1" != x ]; do + case $1 in + -c) instcmd="$cpprog" + shift + continue;; + + -d) dir_arg=true + shift + continue;; + + -m) chmodcmd="$chmodprog $2" + shift + shift + continue;; + + -o) chowncmd="$chownprog $2" + shift + shift + continue;; + + -g) chgrpcmd="$chgrpprog $2" + shift + shift + continue;; + + -s) stripcmd="$stripprog" + shift + continue;; + + -t=*) transformarg=`echo $1 | sed 's/-t=//'` + shift + continue;; + + -b=*) transformbasename=`echo $1 | sed 's/-b=//'` + shift + continue;; + + *) if [ x"$src" = x ] + then + src=$1 + else + # this colon is to work around a 386BSD /bin/sh bug + : + dst=$1 + fi + shift + continue;; + esac +done + +if [ x"$src" = x ] +then + echo "install: no input file specified" + exit 1 +else + true +fi + +if [ x"$dir_arg" != x ]; then + dst=$src + src="" + + if [ -d $dst ]; then + instcmd=: + else + instcmd=mkdir + fi +else + +# Waiting for this to be detected by the "$instcmd $src $dsttmp" command +# might cause directories to be created, which would be especially bad +# if $src (and thus $dsttmp) contains '*'. + + if [ -f $src -o -d $src ] + then + true + else + echo "install: $src does not exist" + exit 1 + fi + + if [ x"$dst" = x ] + then + echo "install: no destination specified" + exit 1 + else + true + fi + +# If destination is a directory, append the input filename; if your system +# does not like double slashes in filenames, you may need to add some logic + + if [ -d $dst ] + then + dst="$dst"/`basename $src` + else + true + fi +fi + +## this sed command emulates the dirname command +dstdir=`echo $dst | sed -e 's,[^/]*$,,;s,/$,,;s,^$,.,'` + +# Make sure that the destination directory exists. +# this part is taken from Noah Friedman's mkinstalldirs script + +# Skip lots of stat calls in the usual case. +if [ ! -d "$dstdir" ]; then +defaultIFS=' +' +IFS="${IFS-${defaultIFS}}" + +oIFS="${IFS}" +# Some sh's can't handle IFS=/ for some reason. +IFS='%' +set - `echo ${dstdir} | sed -e 's@/@%@g' -e 's@^%@/@'` +IFS="${oIFS}" + +pathcomp='' + +while [ $# -ne 0 ] ; do + pathcomp="${pathcomp}${1}" + shift + + if [ ! -d "${pathcomp}" ] ; + then + $mkdirprog "${pathcomp}" + else + true + fi + + pathcomp="${pathcomp}/" +done +fi + +if [ x"$dir_arg" != x ] +then + $doit $instcmd $dst && + + if [ x"$chowncmd" != x ]; then $doit $chowncmd $dst; else true ; fi && + if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dst; else true ; fi && + if [ x"$stripcmd" != x ]; then $doit $stripcmd $dst; else true ; fi && + if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dst; else true ; fi +else + +# If we're going to rename the final executable, determine the name now. + + if [ x"$transformarg" = x ] + then + dstfile=`basename $dst` + else + dstfile=`basename $dst $transformbasename | + sed $transformarg`$transformbasename + fi + +# don't allow the sed command to completely eliminate the filename + + if [ x"$dstfile" = x ] + then + dstfile=`basename $dst` + else + true + fi + +# Make a temp file name in the proper directory. + + dsttmp=$dstdir/#inst.$$# + +# Move or copy the file name to the temp name + + $doit $instcmd $src $dsttmp && + + trap "rm -f ${dsttmp}" 0 && + +# and set any options; do chmod last to preserve setuid bits + +# If any of these fail, we abort the whole thing. If we want to +# ignore errors from any of these, just make sure not to ignore +# errors from the above "$doit $instcmd $src $dsttmp" command. + + if [ x"$chowncmd" != x ]; then $doit $chowncmd $dsttmp; else true;fi && + if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dsttmp; else true;fi && + if [ x"$stripcmd" != x ]; then $doit $stripcmd $dsttmp; else true;fi && + if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dsttmp; else true;fi && + +# Now rename the file to the real destination. + + $doit $rmcmd -f $dstdir/$dstfile && + $doit $mvcmd $dsttmp $dstdir/$dstfile + +fi && + + +exit 0 diff --git a/web/src/cgi.tcl-1.10/install.mac b/web/src/cgi.tcl-1.10/install.mac new file mode 100644 index 00000000..a79c6b72 --- /dev/null +++ b/web/src/cgi.tcl-1.10/install.mac @@ -0,0 +1,70 @@ +This file is install.mac. It contains installation instructions for +cgi.tcl on MacOS. + +If you do not have Tcl, get it (the README explains how) and install +it. The rest of these instructions assume that you have Tcl +installed. + +-------------------- +Installation +-------------------- + +These instructions are based on contributions courtesy of Henk-Jan +Kooiman <hjk@cable.a2000.nl>. Send fixes to me (libes@nist.gov). + +If you just want to experiment with cgi.tcl, you can simply source it +into your Tcl files by saying "source cgi.tcl". + +Once you're done playing, go ahead and install it. To install it: + +1) Make a package index. (This will create pkgIndex.tcl which will +make it possible to use "package require cgi" in scripts.) Asari +Hirotsugu <asari@math.uiuc.edu> has supplied the following +elaboration of this step: + + 1a) Put the cgi.tcl folder in the "Tool Command Language" folder + inside the Extensions folder. (Don't make an alias for the Tool + Command Language folder since Tcl Shell doesn't resolve aliases as + of 8.2.1.) + + 1b) Launch the Tcl Shell (or Wish) and move to the Tool Command + Language folder by entering: + + cd "Macintosh HD:System Folder:Extensions:Tool Command Language" + + (You may have to modify this command depending upon the names + and structure of your file system.) + + Issue the pkg_mkIndex command: + + pkg_mkIndex cgi.tcl* + + 1c) Test if the package comand works by trying: + + package require cgi + +2) You may want to edit some things in cgi.tcl at this time. + + 2a) Upon errors in production code, cgi.tcl sends mail to an + administrator. This can be set on a per-script basis but it + defaults to "root". You'll probably want to change this for your + site. To do that, search cgi.tcl for cgi_admin_mail_addr "root" and + change the argument to whatever you prefer. + + 2b) The cgi_mail_end procedure attempts to do mail delivery using + SMTP (the de facto Internet mail protocol). However, this mechanism + is not robust. For example, if the mail gateway is down, the mail + will not be requeued for later delivery. If you have a robust + mailer program or some other interface, you should switch to using + it. The ability to send mail isn't required for basic use of + cgi.tcl, but this ability is especially useful for in-the-field + debugging so I encourage you to use it. + +You're done! Now you can use cgi.tcl. + +-------------------- +Examples +-------------------- + +The example directory has some examples. See the README in there. + diff --git a/web/src/cgi.tcl-1.10/install.win b/web/src/cgi.tcl-1.10/install.win new file mode 100644 index 00000000..424fc649 --- /dev/null +++ b/web/src/cgi.tcl-1.10/install.win @@ -0,0 +1,105 @@ +This file is install.win. It contains installation instructions for +cgi.tcl on Win95/NT. + +If you do not have Tcl, get it (the README explains how) and install +it. The rest of these instructions assume that you have Tcl +installed. + +-------------------- +Installation +-------------------- + +These instructions are based on contributions courtesy of Maan +M. Hamze <mmhamze@pleiades.net> and Martin Meuer +<martin.meuer@frz.de>. Send fixes to me (libes@nist.gov). + +If you just want to experiment with cgi.tcl, you can simply source it +into your Tcl files by saying "source cgi.tcl". + +Once you're done playing, go ahead and install it. To install it: + +1) Open wish8.0 and run the following: + + pkg_mkIndex c:\\tcl\\lib\\tcl8.0 cgi.tcl + +(assuming that you have Tcl libraries in the above directory). This +This will create pkgIndex.tcl which will make it possible to use +"package require cgi" in scripts. + +2) The only files actually necessary for production use are +pkgIndex.tcl and cgi.tcl. Make sure those files and their directory +have execute permission for the web server scripts. + +3) You may want to edit some things in cgi.tcl at this time. + +3a) The default extension of the files that work with cgi.tcl is .cgi. +In case that extension is already being used by another program for +your cgi programs, you may want to change that extension into +something else, say, .cgt. To do that, search cgi.tcl for the string +.cgi and replace with .cgt or whatever you prefer. + +3b) Upon errors in production code, cgi.tcl sends mail to an +administrator. This can be set on a per-script basis but it defaults +to "root". You'll probably want to change this for your site. To do +that, search cgi.tcl for cgi_admin_mail_addr "root" and change the +argument to whatever you prefer. + +3c) The cgi_mail_end procedure attempts to do mail delivery using SMTP +(the de facto Internet mail protocol). However, this mechanism is not +robust. For example, if the mail gateway is down, the mail will not +be requeued for later delivery. If you have a robust mailer program +or some other interface, you should switch to using it. The ability +to send mail isn't required for basic use of cgi.tcl, but this ability +is especially useful for in-the-field debugging so I encourage you to +use it. + +4) Tcl/Tk 8.0 should have automatically created a file type to run +files with the .tcl extension. Make sure by running: +Explorer...Options....File Types. .tcl files should be associated +with Wish8.0. + +5) The web server must now be told about Tcl. The exact details +depend on your particular server. Here are instructions that people +have sent to me for different servers. (Feel free to send more.) + +5a) If you are using Personal Web Server for Win 95 or MS IIS ver 3 +for Win NT: + + Instructions according to Maan M. Hamze <mmhamze@pleiades.net> + +Run the Registry Editor. +Go to: +HKEY_LOCAL_MACHINE + System + CurrentControlSet + Services + W3SVC + Parameters + Script Map +Create a new String Value through Edit: +First enter the name of the extension (.cgi or the extension you want to use as +in .cgt). Associate the extension with: +FullPathToTclExecutable\tclsh80.exe %s + +5b) If you are using Netscape Enterprise Server: + + Instructions according to Martin Meuer <martin.meuer@frz.de>. + +5b1) Create an association from NT-Explorer (View-Options-Filetypes) for +the extension .cgt to tell NT to open .cgt with "/fullpath/tclsh80.exe +%1" +5b2) From the Server Manager of the Enterprise Server create o new MIME +type for .cnt with type "magnus-internal/shellcgi" +(Alternatively one can create a special shellCGI-Directory instead, +but I rather like to place my scripts anywhere.) + +6) Kill and restart your web server. + +You're done! Now you can use cgi.tcl. + +-------------------- +Examples +-------------------- + +The example directory has some examples. See the README in there. + diff --git a/web/src/cgi.tcl-1.10/mkinstalldirs b/web/src/cgi.tcl-1.10/mkinstalldirs new file mode 100755 index 00000000..0801ec2c --- /dev/null +++ b/web/src/cgi.tcl-1.10/mkinstalldirs @@ -0,0 +1,32 @@ +#! /bin/sh +# mkinstalldirs --- make directory hierarchy +# Author: Noah Friedman <friedman@prep.ai.mit.edu> +# Created: 1993-05-16 +# Last modified: 1994-03-25 +# Public domain + +errstatus=0 + +for file in ${1+"$@"} ; do + set fnord `echo ":$file" | sed -ne 's/^:\//#/;s/^://;s/\// /g;s/^#/\//;p'` + shift + + pathcomp= + for d in ${1+"$@"} ; do + pathcomp="$pathcomp$d" + case "$pathcomp" in + -* ) pathcomp=./$pathcomp ;; + esac + + if test ! -d "$pathcomp"; then + echo "mkdir $pathcomp" 1>&2 + mkdir "$pathcomp" || errstatus=$? + fi + + pathcomp="$pathcomp/" + done +done + +exit $errstatus + +# mkinstalldirs ends here diff --git a/web/src/cgi.tcl-1.10/pkgcreate b/web/src/cgi.tcl-1.10/pkgcreate new file mode 100755 index 00000000..877b6cb3 --- /dev/null +++ b/web/src/cgi.tcl-1.10/pkgcreate @@ -0,0 +1,9 @@ +#!/depot/path/tclsh +# allow for earlier versions of Tcl that don't define pkg_mkIndex +if {[catch {pkg_mkIndex . cgi.tcl}]} { + set f [open pkgIndex.tcl w] + puts $f "error \"please rebuild cgi.tcl with a modern version of Tcl (for package support)\"" + close $f +} + + diff --git a/web/src/cgi.tcl-1.10/version.in b/web/src/cgi.tcl-1.10/version.in new file mode 100644 index 00000000..86adc5dc --- /dev/null +++ b/web/src/cgi.tcl-1.10/version.in @@ -0,0 +1,2 @@ +set versionFull @CGI_VERSION_FULL@ +set version @CGI_VERSION@ |