home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / contrib / cgimail.txt < prev    next >
Internet Message Format  |  1995-02-12  |  4KB
  1. From icon-group-sender Sat Feb  4 16:21:03 1995
  2. Received: by cheltenham.cs.arizona.edu; Sat, 4 Feb 1995 16:20:37 MST
  3. Date: Sat, 4 Feb 95 17:23:24 CST
  4. From: goer@mithra-orinst.uchicago.edu (Richard L. Goerwitz)
  5. Message-Id: <9502042323.AA08253@mithra-orinst.uchicago.edu>
  6. To: icon-group@cs.arizona.edu
  7. Subject: Icon in CGI scripts
  8. Errors-To: icon-group-errors@cs.arizona.edu
  9. Status: R
  10.  
  11. Several people have asked about use of Icon in HTTP-style CGI
  12. scripts.  It seems to me that Icon is a good way of decoding
  13. the results of form requests.  The problem that Icon cannot
  14. handle UTF-8 and/or Unicode is not really a problem, in that
  15. even when HTML starts using these as possible charset types,
  16. ISO 8859-1 will still be universally accepted, and UTF-8 es-
  17. sentially subsumes it (or does it only subsume ASCII - I for-
  18. get).
  19.  
  20. In any case, Icon will work well.  So here's a sample script
  21. that can serve as a template.  Please post additions and ex-
  22. pansions or corrections....
  23.  
  24. Richard Goerwitz
  25.  
  26.  
  27. ==============================================================
  28.  
  29. procedure main(a)
  30.  
  31.     local i, cl, n, name_tbl
  32.  
  33.     cl := integer(getenv("CONTENT_LENGTH"))
  34.     name_tbl := table()
  35.  
  36.     #
  37.     # output a minimal header, terminated by two newlines
  38.     #
  39.     write("Content-type: text/html\x0A\x0A")
  40.  
  41.     #
  42.     # check that the request is correctly formatted; output
  43.     # error message if it's not
  44.     #
  45.     getenv("REQUEST_METHOD") == "POST" | {
  46.         writes("<P>error:  METHOD must = \"POST\"</P>")
  47.         exit(1)
  48.     }
  49.     getenv("CONTENT_TYPE") == "application/x-www-form-urlencoded" | {
  50.         writes("<P>error:  this script is for decoding form results only</P>")
  51.         exit(1)
  52.     }
  53.  
  54.     #
  55.     # enter name=value lines as key/value pairs in name_tbl
  56.     #
  57.     while line := makeline(&input, "&", cl) do {
  58.     line := unescape_url(map(line), "+", " ")
  59.     line ? {
  60.         n := tab(find("="))
  61.         move(1)
  62.         if not (/name_tbl[n] := tab(0)) then {
  63.         writes("<P>error:  duplicate field name, ", n, "</P>")
  64.         exit(1)
  65.         }
  66.     }
  67.     }
  68.  
  69.     #
  70.     # Output results.
  71.     #
  72.     writes("<H1>Query Results</H1>\x0A")
  73.     writes("<P>You submitted the following name/value pairs:</P>\x0A")
  74.     writes("<UL>\x0A")
  75.     every k := key(name_tbl) do
  76.     writes("<LI>", name_tbl[k]," = ", name_tbl[k], "\x0A")
  77.     writes("</UL>\x0A")
  78.  
  79.     exit(0)
  80.  
  81. end
  82.  
  83.  
  84. #
  85. # concatenate series' of non-ampersands into lines; stop
  86. # when you have read the number of characters in cl (arg
  87. # 3)
  88. #
  89. procedure makeline(f, stop_c, cl)
  90.  
  91.     local line, c
  92.     static c_count
  93.     initial c_count := 0
  94.  
  95.     line := ""
  96.     while c := reads(f) do {
  97.     if (c_count +:= 1) > cl then
  98.         break
  99.         if c == stop_c then
  100.         break
  101.     line ||:= c
  102.     }
  103.     return "" ~== line
  104.  
  105. end
  106.  
  107.  
  108. #
  109. # turn &xx (where xx are hex digits) into an integer;
  110. # output the character with that internal integer value
  111. #
  112. procedure unescape_url(url)
  113.  
  114.     local new_url
  115.  
  116.     new_url := ""
  117.  
  118.     url ? {
  119.     while new_url ||:= tab(find("%")) & move(1) do
  120.         new_url ||:= char(hex(move(2))) | tab(0)
  121.     new_url ||:= tab(0)
  122.     }
  123.  
  124.     return new_url
  125.  
  126. end
  127.  
  128.  
  129. #
  130. # Bob Alexander's hex->integer code (overkill here)
  131. #
  132. procedure hex(s)
  133.  
  134.    local a,c
  135.  
  136.    a := 0
  137.    every c := !map(s) do
  138.        a := ior(find(c,"0123456789abcdef") - 1, ishift(a,4)) | fail
  139.    return a
  140.  
  141. end
  142. #
  143. #
  144. procedure hexstring(i,n,lowercase)
  145.  
  146.    local s, hexchars, sign
  147.  
  148.    i := integer(i) | runerr(101, i)
  149.    sign := ""
  150.    if i = 0 then s := "0"
  151.    else {
  152.        if /n & i < 0 then {
  153.        sign := "-"
  154.        i := -i
  155.        }
  156.        hexchars := if \lowercase
  157.        then "0123456789abcdef"
  158.        else "0123456789ABCDEF"
  159.        s := ""
  160.        until i = (0 | -1) do {
  161.        s := hexchars[iand(i,15) + 1] || s
  162.        i := ishift(i,-4)
  163.        }
  164.    }
  165.    if \n > *s then s := right(s,n,if i >= 0 then "0" else hexchars[16])
  166.  
  167.    return sign || s
  168.  
  169. end
  170.  
  171.