-- This is about half of the Euphoria code for EUforum.
-- The parts having to do with moderation, SPAM filtering, passwords etc.
-- are contained in other source files, and for security reasons,
-- are not shown.
-- Save a message in the message archive
-- constants for colors necessary for syncolor.e
global constant NORMAL_COLOR = #330033,
COMMENT_COLOR = #FF0055,
KEYWORD_COLOR = #0000FF,
BUILTIN_COLOR = #FF00FF,
STRING_COLOR = #00A033,
BRACKET_COLOR = {NORMAL_COLOR, #993333,
#0000FF, #5500FF, #00FF00}
include keywords.e
include syncolor.e
include date_calc.e
include file.e
constant SIG_SIZE = 26
-- one-byte tags
constant TAG_MONTH = 1,
TAG_SIGNATURE = 2,
TAG_FROM = 3,
TAG_OFFSET = 4
function mime_data(sequence line)
-- Does this (upper case) line look like MIME or UUCP unreadable data?
return match("BASE64", line)
end function
constant month = {
"Jan",
"Feb",
"Mar",
"Apr",
"May",
"Jun",
"Jul",
"Aug",
"Sep",
"Oct",
"Nov",
"Dec"
}
function pack(sequence signature)
-- pack a 2-d sequence into a string of bytes
sequence bytes
integer p, bit, index
bytes = repeat(0, floor(SIG_SIZE*SIG_SIZE/8)+1)
for i = 1 to length(signature) do
for j = 1 to length(signature[i]) do
if signature[i][j] then
index = (i-1)*SIG_SIZE + (j-1)
p = floor(index/8)+1
bit = power(2, remainder(index, 8))
bytes[p] = or_bits(bytes[p], bit)
end if
end for
end for
return bytes
end function
function count(sequence line, integer c)
-- count number of occurrences of c in line
integer s
s = 0
for i = 1 to length(line) do
if line[i] = c then
s += 1
end if
end for
return s
end function
function all_white(sequence s)
-- return TRUE if s has no non-whitespace characters
return not find(1, s != ' ' and s != '\t' and s != '\n')
end function
function tab(integer tab_width, integer pos)
-- compute new column position after a tab
return (floor((pos - 1) / tab_width) + 1) * tab_width + 1
end function
function expand_tabs(integer tab_width, sequence line)
-- replace tabs by blanks in a line of text
integer tab_pos, column, ntabs
column = 1
while TRUE do
tab_pos = find('\t', line[column..length(line)])
if tab_pos = 0 then
-- no more tabs
return line
else
tab_pos += column - 1
end if
column = tab(tab_width, tab_pos)
ntabs = 1
while line[tab_pos+ntabs] = '\t' do
ntabs += 1
column += tab_width
end while
-- replace consecutive tabs by blanks
line = line[1..tab_pos-1] &
repeat(' ', column - tab_pos) &
line[tab_pos+ntabs..length(line)]
end while
end function
function get_msg_full(integer msg_num)
-- return full message for use in RSS feed
integer m, in_pre, angle, b
sequence msg, actual_name, actual_address, nb_line
object line, skip
m = open(sprintf("../public_html/EUforum/m%d.html", msg_num), "r")
if m = -1 then
return {}
end if
actual_name = "unknown"
actual_address = "unknown"
msg = ""
in_pre = FALSE
for i = 1 to 10000 do
line = gets(m)
if atom(line) then
exit
end if
if in_pre then
if match("</pre>", line) = 1 then
msg = msg & line
exit
end if
nb_line = ""
angle = 0
line = expand_tabs(8, line)
for j = 1 to length(line) do
-- use instead of blank where appropriate
if line[j] = ' ' then
if angle or (j > 1 and line[j-1] != ' ') then
nb_line &= ' '
else
nb_line &= " "
end if
else
if line[j] = '<' then
angle += 1
elsif line[j] = '>' then
angle -= 1
end if
if line[j] != '\n' then
if line[j] <= 31 and not find(line[j], "\t\r") then
-- replace
nb_line &= '^'
if line[j] >= 1 and line[j] <= 26 then
nb_line &= 'A'-1+line[j]
else
nb_line &= '?'
end if
else
nb_line &= line[j]
end if
end if
end if
end for
msg = msg & "<br>" & nb_line
else
if match("From: ", line) then
-- pick out his actual address
b = match("<b>", line)
if b then
actual_address = line[b+3..$]
b = match("</b>", actual_address)
if b then
actual_name = actual_address[1..b-1]
b = match("<", actual_address)
if b then
actual_address = actual_address[b..$]
end if
end if
end if
end if
if match("<pre>", line) = 1 then
in_pre = TRUE
msg &= line
skip = gets(m)
if sequence(skip) and length(skip) > 1 then
msg &= line
end if
msg &= "posted by: " & actual_name & " " & actual_address & "<br>"
end if
end if
end for
close(m)
return msg
end function
function get_s_a_d_b(integer msg_num)
-- extract:
-- [1] subject
-- [2] author
-- [3] date
-- [4] beginning
-- [5] Post URL
-- [6] Reply URL
-- from a message that's in HTML form
integer m, p, q, angle
integer found_pre -- <pre>
sequence subject, author, low_line, mdate, begin, post_url, reply_url
object line
m = open(sprintf("../public_html/EUforum/m%d.html", msg_num), "r")
if m = -1 then
return {}
end if
subject = ""
author = ""
mdate = ""
found_pre = FALSE
begin = ""
post_url = "http://www.RapidEuphoria.com/cgi-bin/usercont.exu?actionType=mboard&msgId=post"
reply_url = ""
for i = 1 to 300 do
line = gets(m)
if atom(line) or not find('\n', line) then
exit
end if
if found_pre then
-- get beginning of message
if match("</pre>", line) then
exit
end if
line = line[1..$-1]
line = line & ' '
p = match(">", line)
if (p = 0 or p > 6) then
if match("Content-Type:", line) != 1 and
match("Content-Transfer-Encoding:", line) != 1 and
match("Content-Disposition:", line) != 1 and
match("-=_Part_", line) = 0 then
if not (match("On ", line) = 1 and match("20", line)) then
if not find('<', line) and not find('>', line) then
p = match("wrote:", line)
if p = 0 or p > 60 then
p = find(0, line = ' ' or
line = '\t' or
line = '\n' or
line = '\r')
if p then
line = line[p..$]
begin &= line
end if
end if
else
if length(begin) < 3 or
begin[$-1] != '.' or begin[$-2] != '.' then
begin &= "... "
end if
end if
end if
end if
end if
else
-- still in header
if length(reply_url) = 0 and match("<b>Reply", line) then
p = match("window.open('", line)
q = match("','usercont", line)
if p > 10 and q > p + 10 then
reply_url = line[p+13..q-1]
end if
end if
low_line = lower(line)
if length(mdate) = 0 and match("date: ", low_line) = 1 then
mdate = line[7..$-1]
end if
if length(subject) = 0 and match("subject: ", low_line) = 1 then
subject = line[10..$-1]
end if
if length(author) = 0 and match("from: ", low_line) = 1 then
author = line[7..$-1]
end if
end if
if match("<pre>", line) then
found_pre = TRUE
end if
end for
close(m)
-- remove HTML from the subject
angle = match("\">", subject)
if angle then
subject = subject[angle+2..$]
angle = match("</a>", subject)
if angle then
subject = subject[1..angle-1]
end if
end if
-- grab only the first part of author address:
angle = match("<", author)
if angle then
author = author[1..angle-1]
end if
angle = match(" at ", author)
if angle then
author = author[1..angle-1]
end if
for i = 1 to length(begin)-1 do
if i > 70 then
-- start looking for end of a sentence
if find(begin[i], ".?!") and
find(begin[i+1], " \t\r\n") then
begin = begin[1..i]
exit
end if
end if
end for
if length(begin) > 200 then
begin = begin[1..200] & "..."
end if
if all_white(subject) then
subject = "(no subject)"
end if
if all_white(author) then
author = "(unknown)"
end if
return {subject, author, mdate, begin, post_url, reply_url}
end function
procedure htmlTop(integer ofile, sequence s)
puts(ofile, "<html><head><title>" & s & "</title>\n")
puts(ofile, "<META NAME=\"KEYWORDS\" CONTENT=\"euphoria, " &
"programming, program, rapid, deployment, programs, download, " &
"language, compiler, interpreter, software, API, Windows, Win95, " &
"Win98, WinNT, WIN32, XP, DOS, 32-bit, freeware, free, games, " &
"shareware, education, microsoft, news, graphics, editor, debug, " &
"debugger, profile, profiler, Linux, BASIC, QBasic, Pascal, C++\">\n")
puts(ofile, "<META NAME=\"DESCRIPTION\" content=\"Recent messages " &
"on EUforum - the discussion forum for the Euphoria Programming " &
"Language for Windows, DOS and Linux. Download it FREE!\">\n")
puts(ofile, "<meta http-equiv=\"Content-Type\" content=\"text/html; charset=ISO-8859-1\">\n")
puts(ofile, "<link REL=StyleSheet HREF=\"mboard.css\" " &
"TYPE=\"text/css\" MEDIA=screen>\n</head>\n")
puts(ofile, "<body bgcolor=\"#FFFFFF\" text=\"#000000\" " &
"link=\"#FF0000\" vlink=\"#666666\" topmargin=3 " &
"bottommargin=25>\n")
puts(ofile, "<basefont size=3 face=\"Arial, Helvetica\">\n")
puts(ofile, "<table border=0 cellpadding=0 cellspacing=0 width=\"100%\">\n")
puts(ofile, "<tr valign=top>\n")
puts(ofile, "<td width=\"50%\"></td>\n")
puts(ofile, "<td width=\"50%\"></td></tr>\n")
puts(ofile, "<tr>\n")
puts(ofile, "<td colspan=2 bgcolor=\"#CCCC99\">" &
"<img src=\"dum.gif\" width=1 height=1></td>\n")
puts(ofile, "</tr>\n")
puts(ofile, "<tr>\n")
puts(ofile, "<td>\n")
puts(ofile, "<table border=0 cellpadding=0 cellspacing=0 " &
"width=\"100%\"> <!-- table 1a -->\n")
puts(ofile, "<tr>\n")
puts(ofile, "<td height=7><img src=\"dum.gif\" width=1 height=1></td>\n")
puts(ofile, "</tr>\n")
puts(ofile, "<tr>\n")
puts(ofile, "<td align=center>" &
"<font face=\"Arial, Helvetica\" color=\"#CC3366\" size=5><b>\n")
puts(ofile, "EUforum Messages</b></font></td>\n")
puts(ofile, "</tr>\n")
puts(ofile, "<tr>\n")
puts(ofile, "<td align=right>" &
"<font face=\"verdana, arial, geneva\" color=\"#006633\" size=1><b>")
puts(ofile, "<i>- <a href=save_in_log.html>Powered by Euphoria</a> -</i></b></font></td>\n")
puts(ofile, "</tr>\n")
puts(ofile, "<tr><td height=7>" &
"<img src=\"dum.gif\" width=1 height=1></td></tr>\n")
puts(ofile, "</table> <!-- table 1a -->\n")
puts(ofile, "</td>\n")
puts(ofile, "<td align=right>" &
"<table border=0 cellpadding=0 cellspacing=0 width=473> " &
"<!-- table 1b -->\n")
puts(ofile, "<tr valign=top>\n")
puts(ofile, "<td width=5></td>\n")
puts(ofile, "<td width=468></td>\n")
puts(ofile, "</tr>\n")
puts(ofile, "<tr>\n")
puts(ofile, "<td></td>\n")
puts(ofile, "<td>\n")
puts(ofile, "<!-- google start -->\n")
puts(ofile, "<script type=\"text/javascript\"><!--\n")
puts(ofile, "google_ad_client = \"pub-5665121458053575\";\n")
puts(ofile, "google_alternate_color = \"FFFFFF\";\n")
puts(ofile, "google_ad_width = 468;\n")
puts(ofile, "google_ad_height = 60;\n")
puts(ofile, "google_ad_format = \"468x60_as\";\n")
puts(ofile, "google_ad_channel =\"9792749668\";\n")
puts(ofile, "google_ad_type = \"text_image\";\n")
puts(ofile,
"google_color_border = [\"6699CC\",\"FF4500\",\"CC99CC\",\"578A24\"];\n")
puts(ofile,
"google_color_bg = [\"003366\",\"FFEBCD\",\"E7C6E8\",\"CCFF99\"];\n")
puts(ofile,
"google_color_link = [\"FFFFFF\",\"DE7008\",\"000000\",\"00008B\"];\n")
puts(ofile,
"google_color_url = [\"AECCEB\",\"E0AD12\",\"00008B\",\"00008B\"];\n")
puts(ofile,
"google_color_text = [\"AECCEB\",\"8B4513\",\"663366\",\"000000\"];\n")
puts(ofile, "//--></script>\n")
puts(ofile, "<script type=\"text/javascript\"\n")
puts(ofile,
" src=\"http://pagead2.googlesyndication.com/pagead/show_ads.js\">\n")
puts(ofile, "</script>\n")
puts(ofile, "<!-- google end -->\n")
puts(ofile, "</td>\n")
puts(ofile, "</tr>\n")
puts(ofile, "</table> <!-- table 1b -->\n")
puts(ofile, "</td>\n")
puts(ofile, "</tr>\n")
puts(ofile, "<tr><td colspan=2 bgcolor=\"#CCCC99\">" &
"<img src=\"dum.gif\" width=1 height=1></td></tr>\n")
puts(ofile, "</table>\n")
end procedure
procedure htmlMainBar(integer ofile, integer isTop, integer maxNumPages,
integer pageNum)
-- display the main bar with "Search", "Post", "Change", "Home" in the
-- Message Board main page.
sequence temp, nextPage, prevPage
puts(ofile, "<table border=0 width=\"100%\" cellpadding=0 cellspacing=0>\n")
puts(ofile, "<tr>\n")
puts(ofile, "<td width=\"16%\" nowrap></td>\n")
puts(ofile, "<td width=\"14%\" nowrap></td>\n")
puts(ofile, "<td width=\"20%\" nowrap></td>\n")
puts(ofile, "<td width=\"19%\" nowrap></td>\n")
puts(ofile, "<td width=\"20%\" nowrap></td>\n")
puts(ofile, "<td width=\"11%\" nowrap></td>\n")
puts(ofile, "</tr>\n")
puts(ofile, "<tr bgcolor=\"#DDDDAA\">\n")
if isTop then
temp = "border-bottom"
else
temp = "border-top"
end if
-- if pageNum is maxNumPages, there is no previous page.
if pageNum = maxNumPages then
prevPage = " "
else
prevPage = sprintf("<b><a class=\"mainbar\" " &
"href=\"http://www.OpenEuphoria.org/EUforum/index%d.html\">" &
"Previous Page</a></b>", pageNum - 1)
end if
-- if pageNum is 1, it's index.html. There is no nextPage.
-- if pageNum is 2, it's index0.html. Next page is index.html.
if pageNum = 1 then
nextPage = " "
elsif pageNum = 2 then
nextPage = "<b><a class=\"mainbar\" " &
"href=\"http://www.OpenEuphoria.org/EUforum/index.html\">" &
"Next Page</a></b>"
else
nextPage = sprintf("<b><a class=\"mainbar\" " &
"href=\"http://www.OpenEuphoria.org/EUforum/index%d.html\">" &
"Next Page</a></b>", pageNum - 3)
end if
puts(ofile, "<td style=\"" & temp & ": 2px solid #CCCC99\" " &
"align=center>" & prevPage & "</td>\n")
puts(ofile, "<td style=\"" & temp & ": 2px solid #CCCC99\" " &
"align=center>" & nextPage & "</td>\n")
puts(ofile, "<td style=\"" & temp & ": 2px solid #CCCC99\" align=center>")
puts(ofile, "<b><a class=\"mainbar\" " &
"href=\"http://www.rapideuphoria.com/listserv.htm\">")
puts(ofile, "Search EUforum</a></b></td>\n")
puts(ofile, "<td style=\"" & temp & ": 2px solid #CCCC99\" align=center>")
puts(ofile, "<b><a class=\"mainbar\" " &
"href=\"#\" onClick=\"window.open('http://www.RapidEuphoria.com/" &
"cgi-bin/usercont.exu?actionType=mboard&msgId=post','usercont'," &
"'toolbar=no,directories=no,location=no,status=no,menubar=yes," &
"scrollbars=yes,resizable=yes,width=700,height=480'); " &
"return false;\">Post a Message</a></b></td>\n")
puts(ofile, "<td style=\"" & temp & ": 2px solid #CCCC99\" align=center>")
puts(ofile, "<b><a class=\"mainbar\" " &
"href=\"#\" onClick=\"window.open('http://www.RapidEuphoria.com/" &
"cgi-bin/usercont.exu?actionType=settings','usercont'," &
"'toolbar=no,directories=no,location=no,status=no,menubar=yes," &
"scrollbars=no,resizable=yes,width=700,height=480'); " &
"return false;\">Change Settings</a></b></td>\n")
puts(ofile, "<td style=\"" & temp & ": 2px solid #CCCC99\" align=center>")
puts(ofile, "<b><a class=\"mainbar\" " &
"href=\"http://www.rapideuphoria.com/index.html\">Home</a></b>" &
"</td>\n")
puts(ofile, "</tr>\n")
puts(ofile, "</table>\n")
end procedure
constant day_of_week = {"Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"}
integer rss
procedure rss_begin(sequence rss_file, sequence title)
-- write start of rss file
rss = open("../public_html/EUforum/" & rss_file, "w")
if rss != -1 then
puts(rss, "<?xml version=\"1.0\" encoding=\"iso-8859-1\"?>\n")
puts(rss, "<rss version=\"2.0\">\n")
puts(rss, "<channel>\n")
printf(rss, "<title>%s</title>\n", {title})
puts(rss, "<link>http://www.OpenEuphoria.org/EUforum/index.html</link>\n")
puts(rss, "<description>Updated regularly</description>\n")
puts(rss, "<language>en-us</language>\n")
printf(rss,
"<lastBuildDate>%s, %d %s %d %02d:%02d:%02d GMT</lastBuildDate>\n",
{day_of_week[ts[WEEKDAY]], ts[DAY], month[ts[MONTH]], ts[YEAR],
ts[HOUR], ts[MINUTE], ts[SECOND]})
puts(rss, "<copyright>Copyright: (C) Rapid Deployment Software, http://www.RapidEuphoria.com</copyright>\n")
end if
end procedure
procedure rss_end()
-- write end of rss file
if rss != -1 then
puts(rss, "</channel>\n")
puts(rss, "</rss>\n")
close(rss)
end if
end procedure
procedure rss_add(integer num, integer long, sequence s_a_d_b)
-- add an entry to either the small or large rss file
integer m, mon, year
sequence hour_minute, subject, author, week_day, the_date
subject = s_a_d_b[1]
author = s_a_d_b[2]
if length(s_a_d_b[3]) > 10 then
hour_minute = s_a_d_b[3]
week_day = s_a_d_b[3][1..3]
the_date = s_a_d_b[3][5..6]
if the_date[2] = ' ' then
the_date = the_date[1..1]
end if
m = find(' ', hour_minute)
if m then
hour_minute = hour_minute[m+1..$]
end if
m = find(' ', hour_minute)
if m then
hour_minute = hour_minute[m+1..$]
end if
m = find('<', hour_minute)
if m then
hour_minute = hour_minute[1..m-1]
end if
else
hour_minute = "12:01"
week_day = "Sun"
the_date = "1"
end if
if rss != -1 then
puts(rss, "<item>\n")
-- get simple, plain author name
m = match("<b>", author)
if m then
author = author[m+3..$]
end if
m = match("</b>", author)
if m then
author = author[1..m-1]
end if
m = match("<a href", subject)
if m then
subject = subject[1..m-1]
end if
printf(rss, "<title>%s</title>\n", {subject})
printf(rss,
"<link>http://www.OpenEuphoria.org/EUforum/m%d.html</link>\n",
num)
if long then
puts(rss, "<description><![CDATA[")
puts(rss, s_a_d_b[4])
printf(rss,
"<br><p><a href=\"%s\"><font color=\"#FF0000\">Post</font></a>",
{s_a_d_b[5]})
puts(rss, " ")
printf(rss,
"<a href=\"%s\"><font color=\"#FF0000\">Reply</font></a>",
{s_a_d_b[6]})
puts(rss, " ")
puts(rss, "<a href=http://www.RapidEuphoria.com/listserv.htm><font color=\"#FF0000\">Search</font></a>")
puts(rss, " ")
puts(rss, "<a href=http://www.RapidEuphoria.com/><font color=\"#FF0000\">Home</font></a>")
puts(rss, "]]></description>\n")
else
printf(rss, "<description>%s writes: %s</description>\n",
{author, s_a_d_b[4]})
end if
printf(rss, "<author>EUforum@topica.com (%s)</author>\n", {author})
printf(rss,
"<guid isPermaLink=\"true\">http://www.OpenEuphoria.org/EUforum/m%d.html</guid>\n",
num)
mon = ts[MONTH]
year = ts[YEAR]
if ts[DAY] < 9 and length(the_date) >= 2 then
-- it's a new month, but message is from old month
mon -= 1
if mon = 0 then
mon = 12
year -= 1
end if
end if
printf(rss,
"<pubDate>%s, %s %s %d %s:00 GMT</pubDate>\n",
{week_day, the_date, month[mon], year, hour_minute})
puts(rss, "</item>\n")
end if
end procedure
constant RSS_NUM_SMALL = 8, -- number in small RSS
RSS_FULL_MAX = 100, -- no more than this in full feed
-- (i.e. when there's a lot of activity. We
-- don't want to slow email clients down too much)
RSS_FULL_MIN = 12, -- no less than this in full
-- (i.e. when there is very little activity)
RSS_FULL_HOURS = 42 -- full normally holds 1 day 18 hours
-- (if people sleep at least 6 hours/day they
-- won't miss anything if they check some time
-- each day)
constant SUBJECT_WIDTH = 75
atom now -- current day/hour factor
function too_old(integer msg_num)
-- check if a message is too old for RSS
object d
integer yyyy, mm, dd, hh
atom this_hour
-- easier to use the O/S date
d = dir(sprintf("../public_html/EUforum/m%d.html", msg_num))
if atom(d) then
return FALSE
end if
d = d[1]
this_hour = getFactor(d[D_YEAR], d[D_MONTH], d[D_DAY]) * 24 + d[D_HOUR]
return this_hour < now - RSS_FULL_HOURS
end function
procedure new_board(integer msg_board, integer start, integer stop,
integer maxNumPages, integer pageNum)
sequence s_a_d_b, bgcolor, buffer, d
htmlTop(msg_board, "Euphoria Programming Language - EUforum " &
"Message Board")
-- display main bar with "Search", "Post", "Change Settings", "Home"
htmlMainBar(msg_board, TRUE, maxNumPages, pageNum)
puts(msg_board, "<p>\n")
-- date, subject, author bar
puts(msg_board, "<table border=0 width=\"100%\" cellpadding=0 " &
"cellspacing=0>\n<tr>\n")
puts(msg_board, "<td width=\"15%\" nowrap></td>\n")
puts(msg_board, "<td width=\"15%\" nowrap></td>\n")
puts(msg_board, "<td width=\"45%\" nowrap></td>\n")
puts(msg_board, "<td width=\"25%\" nowrap></td>\n</tr>\n")
puts(msg_board, "<tr bgcolor=\"#006F37\"><td align=center>" &
"<font face=\"arial\" color=\"FFFFFF\">" &
"<b>Date (GMT) </b>" &
"</font></td>\n")
puts(msg_board, "<td> </td>\n")
puts(msg_board, "<td><font face=\"arial\" color=\"#FFFFFF\"><b>" &
"Subject</b></font></td>\n")
puts(msg_board, "<td align=center><font face=\"arial\" color=\"#FFFFFF\">" &
"<b>Author " &
" </b></font></td>\n")
puts(msg_board, "</tr>\n</table>\n")
-- list of the messages
puts(msg_board,
"<table border=0 width=\"100%\" cellpadding=2 cellspacing=0>\n")
puts(msg_board, "<tr>\n")
puts(msg_board, "<td width=\"16%\" nowrap></td>\n")
puts(msg_board, "<td width=\"59%\" nowrap></td>\n")
puts(msg_board, "<td width=\"25%\" nowrap></td>\n")
puts(msg_board, "</tr>\n")
puts(msg_board, "<tr><td colspan=3><font size=1> </font></td></tr>\n")
bgcolor = "#FFFFE5"
if start < 0 then
start = 0
end if
for i = start to stop do
s_a_d_b = get_s_a_d_b(i)
if length(s_a_d_b) then
buffer = sprintf("<tr bgcolor=%s><td> %s</td>\n",
{bgcolor, s_a_d_b[3]})
if length(s_a_d_b[1]) > SUBJECT_WIDTH then
s_a_d_b[1] = s_a_d_b[1][1..SUBJECT_WIDTH]
end if
buffer &= sprintf("<td><b><a href=\"m%d.html\">%s</a></b></td>\n",
{i, s_a_d_b[1]})
buffer &= sprintf("<td>%s</td>\n</tr>\n",
{s_a_d_b[2]})
puts(msg_board, buffer)
if equal(bgcolor, "#FFFFE5") then
bgcolor = "#FFFFFF"
else
bgcolor = "#FFFFE5"
end if
end if
end for
puts(msg_board, "</table>\n<p> <br>\n")
if pageNum = 1 then
-- create small RSS feed
rss_begin("messages.xml", "EUforum")
for i = stop to stop - (RSS_NUM_SMALL-1) by -1 do
s_a_d_b = get_s_a_d_b(i)
if length(s_a_d_b) then
rss_add(i, 0, s_a_d_b)
end if
end for
rss_end()
-- create full RSS feed
rss_begin("messages_full.xml", "EUforum-full")
d = date()
now = getFactor(1900+d[YEAR], d[MONTH], d[DAY]) * 24 + d[HOUR]
for i = stop to stop - (RSS_FULL_MAX-1) by -1 do
s_a_d_b = get_s_a_d_b(i)
if length(s_a_d_b) then
if (stop-i) > RSS_FULL_MIN and too_old(i) then
exit
end if
s_a_d_b[4] = get_msg_full(i)
rss_add(i, 1, s_a_d_b)
end if
end for
rss_end()
end if
-- display main bar with "Search", "Post", "Home"
htmlMainBar(msg_board, FALSE, maxNumPages, pageNum)
puts(msg_board, "</body></html>\n")
end procedure
procedure htmlBarLine(integer display_msg, integer isTop, sequence poster,
sequence subject, integer msgId)
-- display link bar for each message. It's called for top and bottom display.
sequence temp
puts(display_msg,
"<table border=0 cellspacing=0 cellpadding=0 width=\"100%\">\n")
puts(display_msg, "<tr valign=top>\n")
puts(display_msg, "<td width=\"19%\"></td>\n")
puts(display_msg, "<td width=\"16%\"></td>\n")
puts(display_msg, "<td width=\"19%\"></td>\n")
puts(display_msg, "<td width=\"16%\"></td>\n")
puts(display_msg, "<td width=\"30%\"></td>\n")
puts(display_msg, "</tr>\n")
puts(display_msg, "<tr bgcolor=\"#DDDDAA\">\n")
if isTop then
temp = "border-bottom"
else
temp = "border-top"
end if
puts(display_msg, "<td style=\"" & temp &
": 2px solid #CCCC99\" align=center>\n")
puts(display_msg, "<a class=\"mainbar\" " &
"href=\"#\" onClick=\"window.open('http://www.RapidEuphoria.com/" &
"cgi-bin/usercont.exu?actionType=mboard&msgId=post','usercont'," &
"'toolbar=no,directories=no,location=no,status=no,menubar=yes," &
"scrollbars=yes,resizable=yes,width=700,height=480'); " &
"return false;\"><b>Post</b></a></td>\n")
puts(display_msg, "<td style=\"" & temp &
": 2px solid #CCCC99\" align=center>\n")
printf(display_msg, "<a class=\"mainbar\" " &
"href=\"#\" onClick=\"window.open('http://www.RapidEuphoria.com/" &
"cgi-bin/usercont.exu?actionType=mboard&msgId=%d&poster=%s&" &
"subject=%s','usercont'," &
"'toolbar=no,directories=no,location=no,status=no,menubar=yes," &
"scrollbars=yes,resizable=yes,width=700,height=480'); " &
"return false;\"><b>Reply</b></a></td>\n", {msgId, poster, subject})
puts(display_msg, "<td style=\"" & temp &
": 2px solid #CCCC99\" align=center>\n")
printf(display_msg, "<a class=\"mainbar\" " &
"href=\"m%d.html\"><b>Previous</b></a></td>\n", msgId - 1)
-- We search for "<b> " at first column - so, make sure it starts
-- immediately after '\n'. This is for "Next" link.
puts(display_msg, "<td style=\"" & temp &
": 2px solid #CCCC99\" align=center>\n")
puts(display_msg, "<b> </b></td>\n")
puts(display_msg, "<td style=\"" & temp &
": 2px solid #CCCC99\" align=center>\n")
puts(display_msg, "<a class=\"mainbar\" " &
"href=\"http://www.OpenEuphoria.org/EUforum\"><b>All " &
"Messages</b></a></td>\n")
puts(display_msg, "</tr>\n")
puts(display_msg, "</table>\n")
end procedure
constant URL_CHARS =
"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" &
"#/?%!*\'|,$-_@.&+=:~"
function make_url(sequence line, integer start)
-- add the <a> tag so a url will be clickable
sequence new, url
integer m, i
if match("https://", line) then
url = "https://"
else
url = "http://"
end if
new = line[1..start-1]
i = start+length(url)
while find(line[i], URL_CHARS) do
url &= line[i]
i += 1
end while
if find(url[$], ".!") then
url = url[1..$-1]
i -= 1
end if
new &= "<a href=\"" & url & "\">" & url & "</a>"
line = line[i..$]
m = match("https://", line)
if m = 0 then
m = match("http://", line)
end if
if m then
new &= make_url(line, m)
else
new &= line
end if
return new
end function
function line_wrap(sequence line, integer width)
-- wrap non-empty line, possibly multiple times, at width characters
integer column, c, angle
angle = 0
column = 0
for i = 1 to length(line) do
column += 1
c = line[i]
if c = '<' then
angle += 1
elsif c = '>' then
angle -= 1
end if
if column > width then
if (c = ' ' or c = '\t') and (angle <= 0 or column > width + 80) then
line[i] = '\n'
column = 0
end if
end if
end for
return line
end function
function letter(integer x)
return (x >= 'A' and x <= 'Z') or
(x >= 'a' and x <= 'z')
end function
function word_count(sequence text)
-- roughly, how many blank-separated words are there?
integer b
b = 0
for i = 1 to length(text) do
if find(text[i], "{}()+-&*/=") then
return 0
end if
if text[i] = ' ' and i > 1 and
letter(text[i-1]) then
b += 1
end if
end for
return b
end function
integer eucode
function display_line(sequence line)
-- Clean up certain characters in a line for HTML display.
-- note: line is assumed to have a \n character at the end (and not be empty).
sequence better_line, text, color_line, rest_of_line, low_line
integer c, m, end_eucode, h, color, url, original_length
original_length = length(line)
-- make clickable URL's
url = FALSE
if not eucode then
m = match("https://", line)
if m = 0 then
m = match("http://", line) -- a URL
end if
h = match("<a href=", line) -- already a clickable URL?
if m and (h = 0 or h > m - 5 or h < m - 15) then
line = make_url(line, m)
url = TRUE
end if
end if
better_line = line
low_line = lower(line)
m = match("<eucode>", low_line)
end_eucode = match("</eucode", low_line) or
match("<\\eucode>", low_line) or
match("</eu_code>", low_line)
if m then
-- turn on syntax coloring
eucode = TRUE
init_class()
end if
better_line = ""
for i = 1 to length(line) do
c = line[i]
rest_of_line = low_line[i+1..$]
if not url and find(c, "<>&$") then
-- neutralize special characters - but don't mess up
-- HTML tags and color syntax that we inserted
-- (in a previous message)
if c = '<' and
match("/a>", rest_of_line) != 1 and
match("a href=", rest_of_line) != 1 and
match("eucode>", rest_of_line) != 1 and
match("/eucode>", rest_of_line) != 1 then
better_line &= "<"
elsif c = '>' and
(i < 8 or
(i > 1 and line[i-1] = ' ') or
(not equal("</a", line[i-3..i-1]) and
not match("<a href=", line[1..i-2]) and
not equal("eucode", line[i-6..i-1]))) then
better_line &= ">"
elsif c = '&' and
match("nbsp", rest_of_line) != 1 and
match("amp", rest_of_line) != 1 and
match("lt", rest_of_line) != 1 and
match("gt", rest_of_line) != 1 then
better_line &= "&"
elsif c = '$' then
better_line &= "$" -- needed only by Thunderbird
else
better_line &= c
end if
else
better_line &= c
end if
end for
if eucode then
color_line = SyntaxColor(better_line)
better_line = ""
for i = 1 to length(color_line) do
color = color_line[i][1]
text = color_line[i][2]
if color = NORMAL_COLOR then
if word_count(text) > 3 then
eucode = FALSE -- almost certainly in plain text section
end if
end if
better_line &= "<font color=\"#" & sprintf("%06x", color) & "\">"
better_line &= text & "</font>"
end for
better_line &= '\n'
else
m = 1
better_line = ' ' & better_line
while m do
m = match(" :-)", better_line)
if m and not match("Subject: ", better_line) then
better_line = better_line[1..m-1] &
" <img src=http://www.OpenEuphoria.org/happy.gif alt=\":-)\">" &
better_line[m+4..$]
end if
end while
better_line = better_line[2..$]
end if
if end_eucode then
eucode = FALSE
end if
m = match(">", better_line)
if (m = 1 or (m = 2 and better_line[1] = ' ')) and
not match("><i><font", better_line) and
not match("><i><font", better_line) then
-- quoted line - add italics
h = find('\n', better_line)
if h then
better_line = better_line[1..m+3] & "<i><font color=\"#0000FF\">" &
better_line[m+4..h-1] & "</font></i>\n"
end if
end if
m = find('>', better_line)
return line_wrap(better_line, floor(75 * length(better_line)/original_length) +
25 * (m >= 1 and m <= 3) +
65 * eucode)
end function
procedure fix_next(integer msg_num)
-- make previous message point to new message
integer prev_file, fixed_file
sequence prev_name
object line
prev_name = sprintf("../public_html/EUforum/m%d.html", msg_num-1)
prev_file = open(prev_name, "r")
if prev_file = -1 then
return
end if
fixed_file = open("temp.html", "w")
if fixed_file = -1 then
return
end if
while TRUE do
line = gets(prev_file)
if atom(line) then
exit
end if
if match("<b> </b>", line) = 1 then
line = sprintf("<a class=\"mainbar\" " &
"href=\"m%d.html\"><b>Next</b></a>", msg_num) &
line[14..$]
end if
puts(fixed_file, line)
end while
close(fixed_file)
close(prev_file)
system("mv temp.html " & prev_name, 2)
end procedure
function plus_blanks(sequence string)
-- replace blanks by plus signs for HTML query string
-- also replace unusual characters with hex codes
sequence newstring
newstring = ""
for i = 1 to length(string) do
if string[i] = ' ' or string[i] = '\t' then
newstring &= '+'
elsif string[i] < 'A' or (string[i] > 'Z' and string[i] < 'a') or
string[i] > 'z' then
newstring &= sprintf("%%%02x", string[i])
else
newstring &= string[i]
end if
end for
return newstring
end function
function no_quotes(sequence name)
-- take double quotes out of a name
sequence newname
newname = ""
for i = 1 to length(name) do
if name[i] != '"' then
newname &= name[i]
end if
end for
return newname
end function
function hashfn(sequence text)
-- hash function for poster's names
integer val, m
m = match(" at ", text)
if m then
text = text[1..m-1]
end if
val = 0
for i = 1 to length(text) do
if not find(text[i], ".@;<>& \r\t\n") then
val = remainder(7 * val + text[i], 129123123)
end if
end for
return val
end function
constant faces = {
"verdana",
"arial",
"times new roman",
"courier new, courier",
"comic sans ms"
}
constant colors = {
{140, 0, 0}, -- browny red
{255, 106, 106}, -- salmon
{245, 52, 226}, -- fuschia
{111, 207, 3}, -- bright green
{ 38, 69, 3}, -- dark green
{213, 35, 226}, -- purple-fuscia
{193, 123, 153}, -- faded pink
{ 84, 2, 193}, -- purplish dark blue
{255, 45, 45}, -- orangish red
{202, 0, 0}, -- red
{224, 65, 12}, -- rusty orange
{ 36, 149, 9}, -- green
{155, 21, 255}, -- bright purple
{100, 100, 124}, -- dark gray
{ 96, 47, 149}, -- dark purple
{ 0, 89, 89}, -- dark green
{153, 153, 153}, -- light gray
{ 51, 51, 51}, -- very dark gray
{ 0, 0, 0} -- black
}
function delete_re(sequence s)
-- remove all "Re:" etc
integer r
sequence sl
sl = lower(s)
while TRUE do
r = match("re:", lower(s))
if r then
s = s[1..r-1] & s[r+3..$]
else
exit
end if
end while
return s
end function
function html_to_normal(sequence s)
-- convert HTML special characters into normal characters
integer m
integer found
while TRUE do
found = FALSE
m = match("&", s)
if m then
s = s[1..m-1] & "&" & s[m+5..$]
found = TRUE
end if
m = match("<", s)
if m then
s = s[1..m-1] & "<" & s[m+4..$]
found = TRUE
end if
m = match(">", s)
if m then
s = s[1..m-1] & ">" & s[m+4..$]
found = TRUE
end if
if not found then
exit
end if
end while
return s
end function
constant month_code = "123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
function highlight_subject(sequence line)
-- show subject with link to search
sequence subject
sequence d
integer toMonth, toYear, fromMonth, fromYear
-- line begins with "SUBJECT:"
subject = line[10..$]
if length(subject) and subject[length(subject)] = '\n' then
subject = subject[1..$-1]
end if
d = date()
toMonth = d[2]
toYear = d[1] + 1900
fromMonth = toMonth - 1
fromYear = toYear
if fromMonth = 0 then
fromMonth = 12
fromYear -= 1
end if
fromYear -= 1995
toYear -= 1995
if not match("http://", subject) then
-- make it a link, unless it already contains a link
subject = "<a href=http://www.OpenEuphoria.org/cgi-bin/esearch.exu?thread=1&" &
sprintf("fromMonth=%s&fromYear=%s&toMonth=%s&toYear=%s&postedBy=&keywords=\"",
{month_code[fromMonth], month_code[fromYear], month_code[toMonth], month_code[toYear]}) &
plus_blanks(delete_re(html_to_normal(subject))) & "\">" & subject & "</a>"
end if
return "Subject: " & subject & '\n'
end function
function highlight_author(sequence line)
-- show author name in bold and/or color
sequence author, color_author
integer m, lt, hash, rr, gg, bb, c
sequence face
sequence d
integer toMonth, toYear, next
-- line begins with "FROM:"
line = line[7..$]
lt = find('<', line)
if lt = 0 then
lt = match("<", line)
if lt = 0 then
lt = match(" at ", line)
next = lt + 4
else
next = lt + 4
end if
else
next = lt + 1
end if
if lt then
if lt >= 3 then
author = line[1..lt-1]
else
author = line[next..$]
m = find('@', author)
if m then
author = author[1..m-1]
else
m = match(" at ", author)
if m then
author = author[1..m-1]
else
author = "unknown"
end if
end if
end if
author = delete_whitespace(no_quotes(author))
hash = hashfn(line[1..$]) -- was next..
color_author = "<b>" & author & "</b>"
if remainder(floor(hash / 15), 2) = 0 then
color_author = "<i>" & color_author & "</i>"
end if
c = 1 + remainder(floor(hash / 991), length(colors))
rr = colors[c][1]
gg = colors[c][2]
bb = colors[c][3]
face = faces[1 + remainder(floor(hash / 33777), length(faces))]
color_author = sprintf("<font face=\"%s\" color=\"#%02x%02x%02x\">%s</font>",
{face, rr, gg, bb, color_author})
d = date()
toMonth = d[2]
toYear = d[1] + 1900 - 1995
line = "<a href=\"http://www.OpenEuphoria.org/cgi-bin/esearch.exu?" &
sprintf("fromMonth=6&fromYear=1&toMonth=%s&toYear=%s&postedBy=%s&keywords=\">%s</a>",
{month_code[toMonth], month_code[toYear],
plus_blanks(author), color_author}) &
" " & line[lt..$]
end if
return "From: " & line
end function
constant MAX_NUM_PAGES = 12 -- .html files (index, index0, index1, ..)
constant MESSAGES_PER_PAGE = 80
constant MIN_MSGS_IN_PAGE = 60 -- number of items in index.html
constant GROWTH_LIMIT = 20 -- for items in index.html
global procedure save_in_log(sequence msgfile)
-- save a message in the archive
integer msg, f, offset, a, b, m, n, y
integer msg_board, display_msg, archive, master, out_lines, out_chars
integer line_count, skip, mime, confirmed
integer content_text, content_base64, euforum
sequence up_line, low_line, from, posted_by, poster, subject,
titleSubject, signature, s, postFix
integer x, temp
object line, tl
integer isHeader, real_msg
integer pb, pb_yet
msg = open(msgfile, "r")
if msg = -1 then
return
end if
-- pre-scan for "Posted by:" and "Subject:"
posted_by = ""
poster = ""
subject = ""
titleSubject = ""
real_msg = FALSE
euforum = FALSE
for i = 1 to 120 do
line = gets(msg)
if atom(line) then
exit
end if
if match("- original message follows -", lower(line)) then
real_msg = TRUE
end if
if real_msg then
-- get "from" value for the message, also prepare for the poster's
-- name for "Reply" link
m = match("posted by: ", lower(line))
if m > 0 and m < 4 then
euforum = (m = 1)
posted_by = line[m+11..$]
m = find('<', posted_by)
if m then
poster = posted_by[1..m - 2]
poster = plus_blanks(no_quotes(poster))
else
poster = "unknown" -- this is actually internal error
end if
exit
end if
m = match("from: ", lower(line))
if length(poster) = 0 and m > 0 and m < 4 then
posted_by = line[m+6..$]
m = find('<', posted_by)
if m = 0 then
m = find('@', posted_by)
end if
if m then
if m > 3 then
poster = posted_by[1..m - 1]
if poster[$] = ' ' then
poster = poster[1..$-1]
end if
else
n = find('>', posted_by)
if n then
poster = posted_by[m..n]
else
poster = posted_by[m..$-1] -- no \n
end if
end if
poster = plus_blanks(no_q