Arc: App server

The Arc distribution includes a simple application server in app.arc. The two main features of the app server are account management and improved forms handling.

Running the server

The server can be started simply with
arc>(asv 8080)

However, it is generally better to start the server in a separate thread, so the Arc REPL can be used. This allows the web server to be modified while it is running.

arc> (thread (asv 8080))

Account management

The app server implements user accounts, so a web user can log into a particular account. Optionally, an account can be an "admin" account with access to the administrative features. A user logs into an account with a login form. The user can then log out of the account. The app server also provides web-based account creation and password modification.

The user login uses a simple browser cookie to keep track of the login. Note that the user account management is entirely orthogonal to the fnid-based continuations of the Arc web server. Logins are maintained through a cookie; fnids are passed in the URL or a form field. The app server includes several mechanisms to ensure that a fnid callback is executed by the expected user.

The app server defines the following pages:
/whoami: displays the logged-in userid and IP address, or redirects to login.
/login: logs user in or creates new account.
/logout: logs the current user out.
/admin: displays the administrative page, if the user is logged into an admin account.
/mismatch: displays an error "Dead link: users don't match." This page is used when a fnid is accessed by the wrong (or logged-out) user.

The following is an example page with user authentication; it will run at http://localhost:8080/example. First, the handler ensures the user is logged in, and displays the login page otherwise. The page displays a form saying "This is the example page". When submitted, the page will say, "Hello user". The uform form ensures that the user is still logged in when the form is submitted; otherwise, the page will display the dead link error.

(defopl example req
  (let user (get-user req)
    (uform user req (prn "Hello " user)
      (prn "This is the example page.") (submit))))
The following example illustrates urform. The page http://localhost:8080/urexample will accept a value in a form. When submitted, the continuation function will output a cookie header and redirect to the page "uexample", which will display the cookies.
(defopl urexample req
  (let user (get-user req)
    (urform user req
      (do (prn "Set-cookie: mycook=" (alref (req 'args) "foo")) "uexample")
      (prn "Enter value:") (input 'foo) (submit))))

(defopl uexample req (prn "User " (get-user req)) (br) (prn "Cookies " (req 'cooks)))

Improved forms

The second feature provided by the app server is improved form functionality: markdown and typed forms.

Markdown is a simple mechanism for adding some formatting to plain text. Text surrounded by asterisks is converted to italics. URLs are converted to links. Blank lines indicate paragraph breaks. Lines that are indented and separated from previous lines by a blank line are displayed as preformatted code. The Arc app server provides mechanisms to convert markdown text to HTML, and supports markdown input in forms.

The app server also provides a mechanism to create forms consisting of multiple typed fields in a table. For example, a form can have one string input and one integer input. The types are entirely separate from Arc's datatypes. The following table outlines the supported types:
TypeForm fieldResult
stringtext input of width formwid*String
string1text input of width formwid*String, empty not allowed
inttext input of width numwid*Integer (rounded)
numtext input of width numwid*Number
posinttext input of width numwid*Integer > 0 (rounded)
doctextarea input of width bigformwid*String
texttextarea input of width formwid*String
mdtexttextarea input of width formwid*Markdown text
mdtext2textarea input of width formwid*Markdown text, no links
tokstext input of width formwid*List of string tokens
bigtokstextarea input of width formwid*List of tokens
sexprtext input of width formwid*List of S-expressions.
hexcoltext inputString if the string defines a valid hex color
urltext input of width formwid*URL (empty string allowed).
userstext input of width formwid*List of usernames with bad names filtered out
choiceselect dropdown menu.Type from the choice list
yesnoselect dropdown with "yes" and "no" choices.Boolean, true for input "yes"
The choice type is specified as a list: choice, the type of the choices, and the choices themselves, for instance '(choice int 1 2 3). The mdtext and mdtext2 inputs include a help link to formatdoc-url*.

A typed form is generated by vars-form, which is a fairly complex procedure. It takes a list of field specifications, where each field specification is a list of (type label value view modify question). The type specifier is from the above table. The label is the name assigned to the input field. The initial value of the field is value. If view is nil, the field is skipped. If modify is nil, the field is not modifiable; it is displayed as text rather than an input field. If question is defined, it appears as a caption above the field; otherwise, the label is displayed before the field.

The following example shows a form created by vars-form. When the form is submitted, each name and value is printed, followed by "Done!". The user must log in, if not already logged in. The example runs at the URL http://localhost:8080/vars-form.

(defopl vars-form req
  (vars-form (get-user req)
     '((int field1 42 t t "Enter int:")
       (toks field2 (a b c) t t)
       (string nil "bar" t nil "Can't touch this."))
     (fn (name val) (prn name " " val) (br))
     (fn () (prn "Done!"))
     "Doit"))
The generated form is:

App server

asv [port]
Starts the application server.
>(asv 8080)

User management

get-user req
Gets the user id string associated with req. Returns nil if no associated user.
>(get-user req)
foo
admin user
Tests if user is an administrator; i.e. is in admins*.
>(admin "foo")
Error: reference to undefined identifier: _admins*

goodname str [min [max]]
Tests that str is of the appropriate length and contains no bad characters.
>(goodname "abc")
"abc"
>(goodname "ab!")
nil
logout-user user
Logs out user. The user's entry is removed from logins*, cookie->user*, user->cookie*, and the updated cookie->user* is written to cookfile*.
>(logout-user "foo")
nil
set-pw user pw
Creates (or updates) account with the name user and password pw. Saves hpasswords* in hpwfile*.
>(set-pw "foo" "bar")

defopl name parm [body]
Version of defop to create handler that will redirect to login page if the user is not logged in.
>(defopl foo req (prn "Welcome!"))

uform user req after [body ...]
Generates form that ensures it was submitted by user (by using when-umatch). body outputs the form body to stdout. After submission, the continuation code after is executed; req specifies the varible name in after to receive the request.
>(uform user req (prn "Result") (prn "The form") (submit))

urform user req after [body ...]
Generates form with redirection target with guard that user submitted it. After submission, the continuation expression after is executed and must return the redirect string; req specifies the varible name in after to receive the request.
>(urform user req "newpage" (prn "Form") (submit))

when-umatch user req [body...]
If user matches the user associated with req, executes body. Otherwise executes mismatch-message.
>(defopl ul req (let user (get-user req)
  (when-umatch user req (prn "You are " user))))

when-umatch/r user req [body ...]
Test user for use with redirect. If user is the user associated with req, executes body. Otherwise returns "mismatch", to redirect to the mismatch page.
>(when-umatch/r user req (logout-user user) "example")

userlink user text [body ...]
Outputs a HTML link with text. When clicked, the link will execute body if the user matches user. Similar to onlink, but with the user guard.
>(userlink user "click here" (prn "Thanks for clicking"))

admin-page user [msg]
Generates the administrator page. This page allows new accounts to be created. The current admin login (user) is displayed at the top of the page, along with msg, if present.
>(admin-page user "Please administer...")

login-page switch [msg [afterward]]
Generates a login page. switch is 'register, 'login, or 'both, allowing account creation, account login, or both operations respectively. The top of the page displays msg. After the page completes, the afterward continuation is executed (by default hello-page). afterward is either a function or a (function, redirect-string) pair. The function takes the user name and IP as arguments.
>(defop mylogin req (login-page 'login "Hello"
    (fn (user ip) (prn "Welcome " user ip))))

Typed and marked-up forms

vars-form user fields f done [button [lasts]]
Generates a form for user. fields is a list of (type label value view modify question) lists specifying the form. When submitted, f is executed on each field, with the arguments label newval. Then continuation function done is executed. If there is a modifiable field, a submit button is generated with label specified by button. The lifetime of the associated fnid can be specified with lasts.
md-from-form str [nolinks]
Converts str to markdown after escaping it. URLs will be converted to links unless nolinks is set. Used to generate markdown from form input.
>(md-from-form "Hello *world* &")
"Hello <i>world</i> &#38;"
markdown s [maxurl [nolinks]]
Applies the markdown rules to s to generate HTML.
>(prn (markdown "Text\n\n  Code\nhttp://arcfn.com, and *stuff*"))
Text<p><pre><code>  Code</code></pre>

<a href="http://arcfn.com" rel="nofollow">http://arcfn.com
</a>, and <i>stuff</i>


Text

  Code
http://arcfn.com, and stuff
unmarkdown s
Inverse of markdown to convert HTML to a marked-down string.
>(unmarkdown "Text<p><pre><code>  Code</code></pre>")
"Text\n\n  Code"

Variables

good-logins*
A queue of successful logins, holding lists of the timestamp, IP, and user id.
bad-logins*
A queue of unsuccessful logins, holding lists of the timestamp, IP, and user id.
hpasswords*
Table of passwords mapping from user to hash.
admins*
Admin stuff.
cookie->user*
Table mapping cookies to users.
user->cookie*
Table mapping users to cookies.
logins*
Table of logins mapping from user name to IP address.
hpwfile*
Password file, backs hpasswords*.
>hpwfile*
"arc/hpw"
adminfile*
Admin file, backs admins*.
>adminfile*
"arc/admins"
cookfile*
Cookie file, backs cookie->user*.
>cookfile*
"arc/cooks"
formwid*
Specifies width of form field.
>formwid*
60
bigformwid*
>bigformwid*
80
numwid*
>numwid*
8
formatdoc-url*
>formatdoc-url*
nil

Internals

load-userinfo
Initializes hpasswords*, admins*, and cookie->user.
>(load-userinfo)

mismatch-message
Prints an error message if the user doesn't match the cookie.
>(mismatch-message)
Dead link: users don't match.

"Dead link: users don't match."
admin-gate user
Gates access to admin-page. If user is an admin, displays admin-page, otherwise redirects to login-page.
>(admin-gate "myuserid")
t
user-exists user
Tests if user is not nil and present in hpasswords*.
>(user-exists "myuserid")
t
cook-user user
Generates and saves a cookie for user. Returns the cookie id.
>(cook-user "testuser")
B8wWz7A6
new-user-cookie
Generates a unique cookie id.
>(new-user-cookie)
uYz5dA33
create-acct user pw
Creates a user account. Just a wrapper around set-pw.
>(create-acct "foo" "secret")
nil
disable-acct user
Disables user account by logging user out and changing the password to a random string.
>(disable-acct "badperson")
nil
hello-page user ip
Displays a simple page saying 'hello user at ip'.
prcookie cook
Prints a header field to update cookie user to the value cook.
>(prcookie "myvalue")
Set-Cookie: user=myvalue; expires=Sun, 17-Jan-2038 19:14:07 
GMT

pwfields [label]
Generates HTML for username and password fields, and a submit button, labelled "login" by default.
>(pwfields)
<table border=0><tr><td>username:</td><td>
<input type=text name="u" size=20></td></tr><tr>
<td>password:</td><td><input type=password name="p" size=20>
</td></tr></table><br>
<input type=submit value="login">

username:
password:

good-login user pw ip
Tests if the user and password are valid according to hpasswords*. Returns user on success, and nil on failure. Updates good-logins* or bad-logins as appropriate.
>(good-login "foo" "bar" "127.0.0.1")
nil
shash str
Hashes str to a sha1 digest using openssl.
>(shash "foo")
"0beec7b5ea3f0fdbc95d0dd47f3c5bc275da8a33"
bad-newacct user pw
Tests if the new userid and password are bad (bad length, bad characters, or already in use). Returns an error message if the new account specification is bad, and nil if the information is okay.
>(bad-newacct "foo" "x")
"That username is taken. Please choose another."
varfield typ id val
Prints HTML for an input field of type typ, name id, and value val. typ is one of bigtoks, doc, int, lines, mdtext, mdtext2, num, posint, string, string1, syms, text, toks, url, users. The type of field and the processing of val depend on typ.
>(varfield 'syms 'foo '(a b c))
<textarea cols=60 rows=5 wrap=virtual name="foo">
a b c
</textarea>

text-rows text width [pad]
Detemines how many rows to hold text based on width and padding.
>(text-rows "abcde" 2)
6
needrows text cols [pad]
Determines how many rows are needed to hold text, based on the length of the text and the number of newlines.
>(needrows "abcde" 2)
1
varline type id val
Prints val according to type. id is ignored.
>(varline 'yesno 'junk 1)
yes
text-type type
Tests if type is one of string, string1, url, text, mdtext, mdtext2.
>(text-type 'string1)
t
readvar type str [fail]
Reads variable of type from str. Returns fail (default nil on failure).
>(readvar 'string "a<b>c")
"ac"
showvars fields
Generates table rows for a varfield list of fields.
indented-code s i [newlines [spaces]]
Tests if s is indented code under the markup rules. Returns a pair of the index of the start of the code, and the number of spaces of indentation. Returns nil if not indented code. The first i characters are skipped.
>(indented-code "\n\n  abc" 0)
(4 2)
parabreak s i [newlines]
If s starts with a paragraph break (at least one blank line), returns the index of the start of the paragraph. Otherwise returns nil. Skips the first i characters.
>(parabreak "\n\nabc\ndef" 0)
2
urlend s i
Finds the logical end of a URL embedded in a string, and returns the index of the first character not in the URL. The first i characters are skipped.
>(let url "http://arcfn.com; stuff" (cut url 0 (urlend url 0)))
"http://arcfn.com"
delimc c
Tests if c is a delimiter: a parenthesis, square bracket, curly bracket, or double quote.
>(delimc #\})
t
code-block s i
Markdown formatting: Returns a 'code block', which is terminated by a line that is not indented with whitespace. The first i+1 characters are skipped.
>(code-block "abc\n def\n ghi\njkl" 0)
"bc\n def\n ghi"
splitlines str
Obsolete function.

Copyright 2008 Ken Shirriff.