#!./exu -- Collect Micro-Economy Vote and e-mail it to RDS -- In the HTML form: -- method="POST" action="cgi-bin/economy.exu" -- Set the permission of this .exu file to chmod 755 include wildcard.e include get.e constant TRUE = 1, FALSE = 0 constant TITLE = 1, AUTHOR = 2, MONEY = 3 constant emailaddress = "rds@RapidEuphoria.com", fromemailaddress = "economy@RapidEuphoria.com" function hex_char(integer c) -- is c a valid hex character? return find(c, "0123456789ABCDEFabcdef") end function function hex_val(integer c) -- return value of a hex character if c >= 'A' and c <= 'F' then return 10 + c - 'A' elsif c >= 'a' and c <= 'f' then return 10 + c - 'a' else return c - '0' end if end function function parse_input(sequence s) -- crack the syntax sent from Web browser: aaa=bbb&ccc=ddd&... -- Convert to {{"aaa", "bbb"}, {"ccc", "ddd"}, ...} left-right pairs integer i, c sequence word_pairs, left_word, right_word word_pairs = {} i = 1 s &= {0,0,0} -- end markers while s[i] != 0 do left_word = "" while 1 do -- build left word c = s[i] if c = '=' or c = '&' or c = 0 then exit end if if c = '%' and hex_char(s[i+1]) and hex_char(s[i+2]) then c = 16 * hex_val(s[i+1]) + hex_val(s[i+2]) i += 2 elsif c = '+' then c = ' ' end if left_word &= c i += 1 end while i += 1 right_word = "" while 1 do -- build right word c = s[i] if c = '&' or c = 0 then exit end if if c = '%' and hex_char(s[i+1]) and hex_char(s[i+2]) then c = 16 * hex_val(s[i+1]) + hex_val(s[i+2]) i += 2 elsif c = '+' then c = ' ' end if right_word &= c i += 1 end while i += 1 word_pairs = append(word_pairs, {left_word, right_word}) end while return word_pairs end function procedure print_HTMLheader() -- Start of HTML output to user puts(1, "Content-type: text/html\n\n") puts(1, "Thank You\n") puts(1, "\n") end procedure procedure HTMLError(sequence msg) -- Report fatal error puts(1, "An error occurred. Please notify rds@RapidEuphoria.com
\n") puts(1, msg) puts(1, "\n") abort(1) end procedure procedure UserError(sequence msg) -- Report fatal error puts(1, "

\n") puts(1, msg) puts(1, "\n") abort(1) end procedure function all_blank(sequence text) for i = 1 to length(text) do if not find(text[i], " +\t\r\n") then return 0 end if end for return 1 end function sequence data, name, text, city data = repeat(repeat(0, 3),4) function any_digits(sequence x) -- TRUE if there are one or more digits in x for i = 1 to length(x) do if find(x[i], "0123456789") then return TRUE end if end for return FALSE end function procedure read_input() -- read the data sent from the Web browser sequence key, content, pairs object nbytes, env, query integer filled_in, dollar env = upper(getenv("REQUEST_METHOD")) if equal(env, "POST") then nbytes = getenv("CONTENT_LENGTH") if atom(nbytes) then UserError("read_input - no CONTENT_LENGTH") end if nbytes = value(nbytes) if nbytes[1] = GET_SUCCESS then nbytes = nbytes[2] else UserError("read_input - bad CONTENT_LENGTH") end if query = get_bytes(0, nbytes) else query = getenv("QUERY_STRING") if atom(query) then UserError("read_input - no QUERY_STRING") end if end if pairs = parse_input(query) name = "?" city = "?" text = "?" dollar = 0 for i = 1 to length(pairs) do key = upper(pairs[i][1]) content= pairs[i][2] -- Associate key and value if equal(key, "NAME") then name = content if all_blank(name) then UserError("Please fill in your name. Go Back and try again.") end if elsif equal(key, "CITY") then city = content if all_blank(city) then UserError("Please fill in your city. Go Back and try again.") end if elsif equal(key, "TEXT") then text = content else for j = 1 to 4 do filled_in = 0 if equal(key, sprintf("TITLE%d", j)) then data[j][TITLE] = content if not all_blank(content) then filled_in += 1 end if exit elsif equal(key, sprintf("AUTHOR%d", j)) then data[j][AUTHOR] = content if not all_blank(content) then filled_in += 1 end if exit elsif equal(key, sprintf("MONEY%d", j)) then data[j][MONEY] = content if not all_blank(content) then filled_in += 1 dollar += 1 end if exit end if if filled_in = 1 or filled_in = 2 then UserError("You must fill in the Title, Author and $ fields. Go Back and try again.") end if end for end if end for if match("http://", lower(text)) then UserError("No SPAM please!") end if if atom(data[4][MONEY]) or (length(data[4][MONEY]) > 5 and not any_digits(data[4][MONEY])) then UserError("No SPAM please!") end if if dollar = 0 then UserError("No Contributions? Go Back and fill in at least one row.") end if end procedure constant Month = {"January","February","March","April","May","June", "July","August","September","October","November","December"} function getDate() -- return string with today's date sequence d d = date() return sprintf("%s %d, %d", {Month[d[2]], d[3], 1900+d[1]}) end function sequence dateString dateString = getDate() print_HTMLheader() read_input() -- Send an e-mail to RDS integer mailtemp mailtemp = open("temp.txt", "w") if mailtemp = -1 then HTMLError("couldn't open temp.txt") end if printf(mailtemp, "To: %s\n", {emailaddress}) printf(mailtemp, "From: %s\n", {fromemailaddress}) puts(mailtemp, "Subject: Micro-Economy Vote\n") puts(mailtemp, "\n\n") printf(mailtemp, "name: %s\n", {name}) printf(mailtemp, "city: %s\n\n", {city}) for i = 1 to 4 do printf(mailtemp, "title%d : %s\n", {i, data[i][TITLE]}) printf(mailtemp, "author%d: %s\n", {i, data[i][AUTHOR]}) printf(mailtemp, "money%d : %s\n\n", {i, data[i][MONEY]}) end for printf(mailtemp, "text : %s\n", {text}) close(mailtemp) -- Send some feedback to the user system("/usr/sbin/sendmail -t < temp.txt >/dev/null", 2) puts(1, "") printf(1, "

Thank you %s for your Micro-Economy Vote on %s.
\n", {name, dateString}) puts(1, "It will appear on our Web site within a few hours.\n") puts(1, "

\n") for i = 1 to 4 do if length(data[i][TITLE]) > 0 then printf(1, "", {data[i][TITLE]}) printf(1, "", {data[i][AUTHOR]}) printf(1, "", {data[i][MONEY]}) puts(1, "") end if end for puts(1, "
title : %s
author : %s
money : %s
 


\n") puts(1, "") puts(1, "\n") puts(1, "return to Euphoria main page

\n") puts(1, "") puts(1, "view the Euphoria program you just ran\n") puts(1, "\n")