Tom Moertel's Weblog: Tag ruby

Ruby 1.9 gets handy new method Object#tap

Tom Moertel — Wed, 07 Feb 2007 12:08:00 -0500

Via eigenclass.org I learned that Ruby 1.9 will sport a new Object method called tap, which is something I’ve been hoping for.

What’s tap? It’s a helper for call chaining. It passes its object into the given block and, after the block finishes, returns the object:

an_object.tap do |o|
  # do stuff with an_object, which is in o
end # ===> an_object

The benefit is that tap always returns the object it’s called on, even if the block returns some other result. Thus you can insert a tap block into the middle of an existing method pipleline without breaking the flow. MenTaLguY has some nifty examples of other things you can do with tap.

Fans of Ruby on Rails may recognize tap as similar to RoR’s own returning helper.

Looks like Ruby 1.9 is going to be extra cool for a number of reasons.

Adding Haskell syntax highlighting to the Typo blogging system

Tom Moertel — Wed, 01 Nov 2006 17:01:00 -0500

Last night on #haskell, Don Stewart asked if I had seen HsColour for rendering syntax-highlighted Haskell in HTML. He had used it recently, he noted in passing, to add syntax highlighting to planet.haskell.org.

Now, I can’t be certain about this, but I suspect that Don’s question was cleverly designed to instill in me a subtle case of syntax-highlighting envy. For on my blog, Haskell code snippets were rendered in dreadfully boring uncolored text. But on his blog, the snippets dance in joyous polychromatic splendor.

Thus I was compelled to add Haskell syntax-highlighting to my blog.

Adding Haskell syntax-highlighting to Typo

My blog runs on the Ruby-on-Rails-powered Typo system, which allows for plug-in text filters. One of the included filters, in fact, is a syntax-highlighting filter for snippets of Ruby, XML, and YAML code. This filter is built upon the Ruby Syntax module, which wasn’t exactly designed for Haskell syntax analysis. So I set out to create a new plug-in filter based upon HsColour.

This task turned out to be easy. All I did was duplicate Typo’s existing syntax-highlighting filter and swap out its filtering code for the following:

IO.popen("HsColour -css", "r+") do |f|
  pid = fork { f.write text; f.close; exit! 0 }
  f.close_write
  text = f.read
  Process.waitpid pid
end

I also tweaked the post-processing regular expressions so that they would whittle away the HTML filler before and after the syntax-highlighted output of HsColour:

text.gsub!(/.*<p()re>/m, ...)
text.gsub!(/<\/pre>.*/m, ...)

A few more tweaks and I was done.

Now I can wrap my Haskell code in <typo:haskell> tags and it, too, will dance in joyous polychromatic splendor:

constructTable tspecs = do
    ecolspecs <- during "argument evaluation" $ do
        toNvps . concat =<< mapM splice tspecs
    let names = map fst ecolspecs
    let evecs = map snd ecolspecs
    vecs <- argof nm $ mapM evalVector evecs
    let vlens = map vlen vecs
    if length (group vlens) == 1
        then return . VTable $ mkTable (zip names vecs)
        else throwError $
             "table columns must be non-empty vectors of equal length"
  where
    nm = "table(...) constructor"
    splice (TCol envp)  = return [envp]
    splice (TSplice e)  = do
        val <- eval e
        case val of
            VTable t ->
                return $ zipWith mkNVP (tcnames t) (elems (tvecs t))
            VList gl ->
                liftM (zipWith mkNVP (map name . elems $ glnames gl)) $
                mapM asVectorNull (elems $ glvals gl)
            _ -> throwError $
                "can't construct table columns from (" ++
                show val ++ ")"
    mkNVP n vec = NVP n (mkNoPosExpr . EVal $ VVector vec)
    name ""     = "NA"
    name n      = n

If you want the filter code, here it is: haskell_controller.rb. Just drop it into components/plugins/textfilters and restart Typo. The corresponding CSS styles can be found in my user-styles.css.

A type-based solution to the "strings problem": a fitting end to XSS and SQL-injection holes?

Tom Moertel — Wed, 18 Oct 2006 21:40:00 -0400

Even skilled programmers have a hard time keeping their web applications free of XSS and SQL-injection vulnerabilities. And it shows: a sobering portion of web sites are open to some scary security threats.

Why are so many sites vulnerable to these well-known holes? Probably because it’s insanely hard for programmers to solve the fundamental “strings problem” at the heart of these vulnerabilities. The problem itself is easy to understand, but we humans aren’t equipped to carry out the solution. Simply put, we just plain suck at keeping a bazillion different strings straight in our heads, let alone consistently and reliably rendering their interactions safe whenever they cross paths in a modern web application. It’s easy to say, “just escape the little buggers,” but it’s hard to get it right, every single time.

Computers, on the other hand, are pretty good at keeping track of details by the bucket-full. Wouldn’t it be nice, then, if our programming languages gave us the power to delegate this nasty “strings problem” to our computers, which could then devote their unwavering mechanical precision to grinding the problem out of existence? Isn’t that the kind of thing modern programming languages are supposed to be good at?

I’d like to think the answer to that question is a big, you betcha.

So let’s grab a modern programming language and solve the strings problem.

Let’s solve the strings problem in Haskell

In this article, we will look at one way (among many) to solve the strings problem: by adding Ruby-style string templates to Haskell. These templates support “interpolation” via the usual, convenient #{var} syntax, but here interpolation is type safe. Haskell’s type system will prevent us from inadvertently mixing incompatible string types, and it will detect mistakes at compile time, before they can become live XSS or SQL-injection holes. Further, our solution will offer us these benefits without making us jump through hoops or pay some onerous syntax penalty.

To be more specific, the system offers the following benefits:

It provides a string-management kernel that lets you create “safe strings” by certifying a regular string as representing either text or a fragment of a known language.
It allows you to conveniently define new language types for any string-based language that you can provide an escaping rule for (e.g., XML, URLs, SQL, untrusted user input).
It provides compile-time syntactic sugar (via Template Haskell) that makes working with safe strings as convenient as working with string interpolation in languages like Ruby and Perl.
It catches and reports (at compile time) the following commonly made programming errors:
- failing to escape a plain-old-text string before mixing it into a string that represents a language fragment
- mixing strings that represent fragments of incompatible languages
- mixing strings that represent fragments of compatible languages in an ambiguous way (the system will force you to disambiguate)

(This is a long one, so grab an espresso, lean back, and read on in style. Also, if you have a smoking jacket, you might want to get it now.)

Before I describe this Haskell-based solution, let’s take a closer look at the strings problem and review why a type-based approach makes sense. (If you already understand the strings problem and are convinced that it is both important and tricky to solve, feel free to skim the first third of this article.)

Examining the “strings problem”

Most web applications are just business-logic-driven string processors. They take strings from user-submitted forms, database queries, web-service responses, templates, and myriad other sources, and they combine the strings to generate yet more strings, which they emit as output and fling across the Internet, into your web browser.

For example, consider this snippet of Ruby (on Rails) code that I used to add submit-to-Reddit and submit-to-del.icio.us buttons to articles on my blog:

def submit_this_article_links(article)
  site_list(article).map do |submit_title, submit_url, image_tag|
    %(<a href="#{h submit_url}" 
         title="#{h submit_title}: &#x201C;#{h article.title}&#x201D;" 
      >#{image_tag}</a>)
  end.join("&#160;")
end

def site_list(article)
  u_title = u(article.title)
  u_url = u(url_of(article, false))
  [  # I really belong in a database table
    [ "Submit to Reddit.com",
      "http://reddit.com/submit?url=#{u_url}&title=#{u_title}",
      image_tag("reddit.gif", :size => "18x18", :border => 0)
    ],
    [ "Save to del.icio.us",
      "http://del.icio.us/post?v=2&url=#{u_url}&title=#{u_title}",
      image_tag("delicious.gif", :size => "16x16", :border => 0)
    ]
  ]
end

When writing this code, I had to keep track of at least three different kinds of strings:

Plain-old text, e.g., article titles
URLs, e.g., article permalinks
XHTML fragments, e.g., the hypertext link to Reddit’s submission form

In code like this, each type of string must conform to the requirements of its own little language, and it’s the programmer’s job – your job – to make sure that differences in these requirements are accounted for when combining strings. Getting it right is a difficult trick to pull off, and getting it right consistently is something even the best developers have difficulty doing.

In the tiny snippet of code above, for example, I had to remember to do all of these things:

URL-escape (using the u helper method) the article’s title before inserting it into the submit-URL template
URL-escape the URL for the article’s permalink before inserting it into the submit-URL template
HTML-escape (using the h helper method) the final, expanded submit-URL template before inserting it into the hypertext-link template
HTML-escape the submit-title (e.g., “Submit to Reddit”) before inserting it into the hypertext-link template
HTML-escape the article’s title before inserting it into the hypertext-link template

That’s a lot to keep track of when coding.

But that’s not all. I also had to know not to escape the result of calling image_tag, because that helper method returns an HTML fragment, which is already in the language of the hypertext-link template into which it is inserted. Escaping it would have turned the image-element markup into embedded text that happens to look a lot like HTML markup.

And that’s not the worst of it. If you screw up any one of these steps for the typical web application, you open the door to a host of nasty problems. If you’re lucky, the damage will be contained to broken links or a rendering problem that most people won’t notice, maybe a weird database error now and again. In the worst case, however, you’re screwed: Your application’s customers become vulnerable to cross-site-scripting (XSS) attacks and your database is opened to injected SQL, through which enterprising crackers might steal your customers’ account data or do even nastier things.

Clearly, the strings problem is common enough and nasty enough to merit our attention. Many of our favorite problem-stomping practices, however, have not proved effective on the ever-tricky strings problem.

Unit testing is an inefficient solution to the strings problem

Unit testing is one of the most efficient programming practices for increasing the quality of software. If you write unit tests pervasively as you code, you are likely to nip many kinds of programming problems in the bud, saving time and effort, which you can then re-invest in your code. Further, unit-testing suites make for swell regression-detection nets and thus free you to refactor crufty code without fear of introducing breakage elsewhere. As a result, you’re more likely to keep your code lean and mean.

Despite its general effectiveness, unit testing is an inefficient way to defend against the perils of the strings problem. That’s because the strings problem is caused by knowledge deficits, which you can’t test for. If you don’t realize that you must escape one URL before you stuff it into another URL, you probably won’t think to write tests for that requirement.

Moreover, if you do think to write the tests, it’s expensive to get them right. In most unit testing scenarios, getting the tests right is usually easier or at least comparable in difficulty to getting the code that’s being tested right. That’s why unit testing is usually so efficient. For the strings problem, however, getting the tests right is often much more expensive than writing typical string-handling code. In my code sample above, for example, there are at least six ways the strings problem can cause trouble. How do you test for them all without making a mistake? It’s not easy.

In sum, unit testing probably isn’t the answer to the strings problem.

Eating and having one’s cake: a type-based solution

An ideal solution would combine the safety of the question-marks solution with the straightforward convenience of string interpolation, and it would work for all kinds of strings, not just SQL, and, because I’m implementing it in Haskell, it would lovingly nestle into Haskell’s type system and gain the full benefits of type-inferencing goodness.

How would it work? Well, let’s back up and think about strings for a moment. We can divide strings into two classes: (1) those that represent text, in which every character represents literally itself; and (2) those that represent fragments of interpreted languages, such as XML or SQL, where each character’s interpretation depends on the rules of the associated language. In text, for example, an ampersand (“&”) represents an ampersand, but in XML an ampersand represents the start of a character-entity reference.

It doesn’t make sense, then, to join text strings directly with language-fragment strings. If you did join them, text characters could be misinterpreted as language characters. For the same reason, it doesn’t make sense to join fragments of different languages together. (It does make sense, however, to escape text strings or language fragments “into” a target language and then join them with strings in the target language.)

A sound solution, therefore, should enforce the following fundamental, safe-string-handling rule: Do not allow strings that represent fragments of one language to be directly joined with strings that represent either plain text or fragments of another language.

The trick is making the computer enforce this rule for us. As it turns out, modern type systems absolutely love to do this kind of thing.

A solution to the strings problem in Haskell

Making the computer enforce our safe-string-handling rule in Haskell is fairly easy. All it takes is a little code. (As we go through the following code, remember that we’re writing a library. Normally, as users of the library, this code would be invisible to us.)

To begin, we create a module for our code and export the essential types and functions that make up our about-to-be-written safe-string kernel:

module SafeStrings
(
  Language(..),
, SafeString -- we export the data type but not the constructors
, empty, frag, text
, cat, (+++)
, render, renders, lang
, q
, declareSafeString
)
where

In order to create safe strings that correspond to particular languages, we need to tell the computer what we mean by Language:

class Language l where
    litfrag  :: String -> l   -- String is a literal language fragment
    littext  :: String -> l   -- String is literal text
    natrep   :: l -> String   -- Gets the native-language representation
    language :: l -> String   -- Gets the name of the language

Here we’re saying that Language is the class of languages, i.e., all data types l for which we can provide four functions:

litfrag – converts a string that represents a language fragment into a language fragment
littext – converts a string that represents plain text into a language fragment that represents the text (via escaping)
natrep – converts a language fragment, verbatim, into a string that represents the language fragment
language – returns the name of the language associated with a given fragment

Further, we need to declare a few “language laws” that conforming Language types must obey. These laws are for us. They will keep us honest when teaching the computer about new languages. Here are the two laws we will require language types to satisfy:

natrep (litfrag s) == s
natrep (littext s) == (escape_L s)

The first law requires that (natrep . litfrag) be equivalent to the identity function for strings. The second law requires that (natrep . littext) be equivalent to the text-escaping function for a given language L. For example, for the language XML:

natrep (litfrag "<em>wow!</em>") ==> "<em>wow!</em>" 
natrep (littext "ham & eggs")    ==> "ham &amp; eggs"

Next, let’s construct a type-safe container for strings having a known language:

data Language l => SafeString l
    = SSEmpty
    | SSFragment l
    | SSCat (SafeString l) (SafeString l)

This data-type definition says that if l is a language, we can construct SafeString values for that language. Each value can represent an empty fragment of the language (via SSEmpty), a non-empty fragment of the language (via SSFragment), or the concatenation of two other SafeString values for the language (via SSCat).

Now comes the interesting part. We are going to leverage the type system to enforce the safe-string-handling rule for us.

We will do this using the SafeString data type we just defined. We have already placed the data type’s definition into a module that does not export the type’s data constructors. That means we will not be able to create SafeString values for ourselves. Instead, we must ask a small set of kernel functions, which are exported, to create the values on our behalf.

These kernel functions, which we are about to write, will create SafeString values only in accordance with our safe-string-handling rule. In particular, they will require us to certify that an existing string represents either text or a language fragment before creating a corresponding SafeString value for us. From then on, the type system will know which language the string is associated with and prevent us from joining it to regular strings or to SafeString values associated with other languages.

Let’s write these constructor functions now:

empty      :: Language l => SafeString l
empty       = SSEmpty

frag, text :: Language l => String -> SafeString l
frag f      = SSFragment (litfrag f)
text s      = SSFragment (littext s)

Here’s what the functions do:

empty – creates an empty SafeString in the Language l
frag f – takes a string that you certify as representing a fragment in the Language l and returns a corresponding SafeString
text s – takes a string that you certify as representing text and returns a corresponding SafeString in the Language l

Once the kernel creates SafeString values for us, we need some way to combine them safely. Thus we define the (+++) operator and the cat function:

-- join two SafeStrings of the same language
(+++) :: Language l => SafeString l -> SafeString l -> SafeString l
(+++)  = SSCat

-- join a list of same-language SafeStrings
cat   :: Language l => [SafeString l] -> SafeString l
cat    = foldr (+++) empty

Finally, we need a way to convert SafeString values into normal strings so that we can pass them through the boundaries of our safe-string-protected code and into the outside world. For this, we write the render function:

render ss = renders ss ""

renders SSEmpty        = id
renders (SSFragment a) = (natrep a ++)
renders (SSCat l r)    = renders l . renders r

(Don’t worry about the renders stuff. It implements a Haskell idiom for fast string concatenation.)

As a convenience, let’s round out our kernel with a Show instance that tells Haskell how to format SafeString values for display.

instance Language l => Show (SafeString l) where
    showsPrec _ ss =
        (lang ss ++) . (":\"" ++) . renders ss . ('"':)

lang ss =
    let SSFragment e = ss in language (undefined `asTypeOf` e)

And that’s our SafeStrings kernel.

Another look at the SafeStrings kernel

The following illustration, complete with poorly chosen colors, provides a visual summary of our system:

(Don’t worry about the $(q ...) stuff for the moment, we’ll talk about it later.)

Activating our mad art-interpretation skillz, we can now decipher the illustration:

Regular strings gain “admittance” to the SafeStrings kernel only via the text and frag certification functions, which we use to create corresponding safe strings for a given language. Once created, the safe strings live their entire lives in the fleshy-colored, egg-shaped protective sac that is the kernel, whose safe-string functions and operators use Haskell’s type system to prevent us from accidentally mixing the strings in unsafe ways. Further, because the kernel does not export its underlying data structures, we can’t screw around with the innards of our safe strings to break the kernel’s promises. When our safe strings have finally reached their ultimate, beautiful state, we can render them into regular strings and pass them bravely into the cruel outside world – where, most likely, somebody else’s broken code will screw them up anyway. But at least we tried.

Our first SafeString module: SafeXml

Now that we have written our SafeStrings kernel, let’s use it to create a SafeXml module that we can use for working with XML. Again, we will be writing library code that under normal circumstances would be hidden from view.

First, we will create a new module that uses the SafeStrings kernel:

module SafeXml
( Xml, xml, renderXml, module SafeStrings )
where
import SafeStrings

Next, we will create a wrapper type to testify that a string represents a fragment of XML:

newtype XmlString
    = XmlString { unXmlString :: String }
    deriving Show

If you go back and look at the export list for the module, you’ll see that the XmlString data type is not exported. It is internal to the module, and thus we, as clients of the module, can’t create values of that type. That means we can’t “forge” XML strings into existence. We can create them only through the safe-string kernel, and even then only by certifying a regular string as representing text or a language fragment. (The kernel, in turn, will create the needed values through the Language interface, which we now discuss.)

Like all good language types, XmlString needs to be a member of the Language type class, so we provide the necessary instance functions:

instance Language XmlString where
    litfrag  = XmlString
    littext  = XmlString . escapeXml
    natrep   = unXmlString
    language = const "xml"

Note that the functions satisfy the language laws we defined earlier. (The proof follows immediately from the definitions of XmlString, unXmlString, and escapeXml.)

Next, we need to write a function to implement the escaping rule for XML:

escapeXml xs =
    concatMap esc xs
  where
    esc '<'  = "&lt;"
    esc '&'  = "&amp;"
    esc '"'  = "&#34;"
    esc '\'' = "&#39;"
    esc x    = [x]

Next, because we expect to work with XML frequently, we will create a convenient type synonym, Xml, for SafeString values that represent XML:

type Xml = SafeString XmlString

Finally, we will create a few convenience functions to create and render XML fragments. These functions are identical to the SafeString kernel’s frag and render functions but for the Xml type exclusively. When we use these functions, we won’t need to provide additional type annotations; the computer will know we are dealing with XML strings:

xml :: String -> Xml
xml = frag

renderXml :: Xml -> String
renderXml = render

And we’re done.

Before going on, let me point out two things:

If you think the code we have written so far is long or perhaps confusing, please remember that it is library code. Typically, you would never see it. All you would do is import SafeXml and start using the library.
The SafeXml implementation is formulaic, and we can replace all of it except for the escaping function’s definition with a single line of code, something we will do later.

A quick test drive of our SafeXml module

Let’s give our SafeXml module a spin in the GHC interactive shell.

We can create an XML fragment by certifying that a regular string represents a language fragment (via the frag function) and telling Haskell that we expect a result of type Xml.

Ok, modules loaded: SafeXml, SafeStrings.
*SafeXml> frag "<em>wow!</em>" :: Xml
xml:"<em>wow!</em>"

Note how the output is prefixed with the label “xml:” to tell us that our kernel certifies this value to represent an XML fragment.

Because entering type annotations can be inconvenient, we can instead use the xml function, which certifies a string not just as a fragment but as an XML fragment:

*SafeXml> xml "<em>wow!</em>" 
xml:"<em>wow!</em>"

If we want to represent text in XML, the kernel will automatically escape it for us:

*SafeXml> text "ham & eggs" :: Xml
xml:"ham &amp; eggs"

Now let’s try to do something naughty. Will the type system let us?

*SafeXml> let someXml = xml "<em>Hi!</em>" 
*SafeXml> let plainOldText = "ham & eggs" 
*SafeXml> someXml ++ plainOldText

<interactive>:1:0:
    Couldn't match `[a]' against `Xml'
      Expected type: [a]
      Inferred type: Xml
    In the first argument of `(++)', namely `someXml'
    In the definition of `it': it = someXml ++ plainOldText

In Haskell, the (++) operator is used (among other things) to join strings. In the code above, we tried to use this operator to join an XML fragment to a plain-old string, which would have violated our safe-string-handling rule. Fortunately, we were unable to fool the type system into allowing this ill-conceived union to occur. Note that our mistake was caught at compile time, before the code was ever converted into executable form.

Perhaps we can persuade our newly-defined (+++) operator to make the union:

*SafeXml> someXml +++ plainOldText

<interactive>:1:12:
    Couldn't match `SafeString XmlString' against `[Char]'
      Expected type: SafeString XmlString
      Inferred type: [Char]
    In the second argument of `(+++)', namely `plainOldText'
    In the definition of `it': it = someXml +++ plainOldText

Again, the type system has prevented us from doing something naughty. If, however, we certify that the plain-old string represents text, we can make a safe union:

*SafeXml> someXml +++ text plainOldText
xml:"<em>Hi!</em>ham &amp; eggs"

Syntactic sugar for safe strings

Not having to worry about the strings problem anymore is fabulous and all, but having to type in frag, text, and +++ is kind of clunky. Let’s get rid of the clunkiness by introducing some syntactic sugar.

The common case when dealing with strings in web applications is templates. For example, here’s a simplified version of the link_to method from the deservedly popular Ruby on Rails. The method wraps a hypertext link around some content by “interpolating” the content and a URL into a link template:

# NOTE: this example is in Ruby

def link_to(content_xhtml, url)
  "<a href=\"#{h url}\">#{content_xhtml}</a>" 
end

In this code, we need to HTML-escape the URL (via the h helper) before interpolating it into the template. We do not need to escape the content, however, because it is already in the template’s language, XHTML.

Now, to introduce our syntactic sugar, here’s link_to rewritten in Haskell and using safe strings:

-- Haskell code

link_to :: Xhtml -> Url -> Xhtml
link_to content url =
    $(q "<a href=\"#{r url}\">#{=content}</a>")

The type signature makes clear to everybody that the content parameter is XHTML, the url parameter is a URL, and the result is XHTML. The signature isn’t needed, but link_to is the stuff of libraries, and so annotations are good form.

The interpolation syntax is like Ruby’s, but with slightly different modifiers:

The template-quoting syntax is $(q "this is a template"). (Mnemonic: q for quote).
Within a template, we can interpolate variables using the familiar #{var} syntax.
If an interpolated variable holds a plain string, it will be escaped into the template automatically.
If an interpolated variable holds a safe string, we must use an interpolation modifier to specify how it should be interpolated (to avoid ambiguity):
- #{r var} renders the safe string in var into text, and then interpolates the text into the template, escaping as necessary (mnemonic: r for render).
- #{= var} inserts the safe string in var directly into the template, which must be of the same language (mnemonic: = for equal language types).
As a bonus, #{s var} interpolates any Show-able value in var into the template as text, escaping as necessary.

It’s pretty easy to tell which interpolation option is right for any situation, but late-night coding sessions make fools of us all. That’s why the type system is there to catch us when we make a dumb mistake.

Let’s try out the sugary link_to method:

> link_to (text "Tom's Weblog") (url "http://blog.moertel.com/")
xml:"<a href="http://blog.moertel.com/">Tom's Weblog</a>"

Let’s take advantage of type inferencing in the next example:

> link_to $(q "<em>Espresso!</em>")
          $(q "http://google.com/search?q=espresso&oe=utf-8")

xml:"<a href="http://google.com/search?q=espresso&amp;oe=utf-8">
     <em>Espresso!</em></a>"

In the above example, we supplied templates as input parameters. Haskell figured out their types and took care of the escaping (or not escaping) for us.

Now that we know what the syntactic sugar looks like, let’s see how to implement it.

Implementing the syntactic sugar using Template Haskell

We implement the SafeString library’s syntactic sugar using Template Haskell. A small function q (for “quote”) parses the sugared syntax at compile time and emits equivalent code using our safe-string functions frag, text, and so on. For example, the following sugar:

$(q "<em>#{mystr}</em>")

becomes the following code:

cat [frag "<em>", text mystr, frag "</em>"]

The code that makes it happen is fairly straightforward if you know Template Haskell, so I’ll skip the explanation because this article is already way too long. As usual, it’s library code, so normally we wouldn’t see or care about it. All we care about is the $(q "...") sugar that the code makes available to us.

Here it is:

import Language.Haskell.TH
import qualified Text.ParserCombinators.ReadP as P

-- Convert template sugar into calls to frag, text, cat, etc.
-- This function is exported by the SafeStrings module.

q spec =
    [| cat $(parts) |]
  where
    parts = case xparse spec of
        []   -> error ("bad template: " ++ show spec)
        ps:_ -> foldr gen [| [] |] ps
    gen p ps' = (\p' -> [| $p' : $ps' |]) $ case p of
        SFrag s  -> [| frag $(litE (stringL s))         |]
        SIFrag s -> [| $(varE (mkName s))               |]
        SIShow s -> [| text (show $(varE (mkName s)))   |]
        SITxt s  -> [| text $(varE (mkName s))          |]
        SIRTxt s -> [| text (render $(varE (mkName s))) |]

-- AST for template-specification parts

data SpecPart
    = SFrag String  -- ^ language fragment
    | SIFrag String -- ^ insert fragment by variable reference
    | SIShow String -- ^ insert rendered variable via show
    | SITxt String  -- ^ insert literal text variable
    | SIRTxt String -- ^ insert rendered safe string var as text
  deriving Show

-- Parse a template specification

xparse spec = do
    (result, "") <- P.readP_to_S templateP spec
    return result
 where
    templateP = do
        P.many ((liftM SFrag (P.munch1 (/= '#'))) P.<++
                interpolationP P.<++
                liftM SFrag (P.string "#"))

    interpolationP = do
        P.string "#{"
        spec <- P.manyTill P.get (P.char '}')
        return $ case spec of
          'r':' ':var -> SIRTxt (strip var)
          's':' ':var -> SIShow (strip var)
          '=':var     -> SIFrag (strip var)
          var         -> SITxt  (strip var)

strip = frontAndBack (dropWhile (== ' '))
frontAndBack f = reverse . f . reverse . f

More sugar: defining additional safe-string types

One additional bit of Template Haskell code, which I won’t reprint here, defines declareSafeString. This function lets us eliminate the boilerplate code when defining new safe-string types. For example, compare our earlier definition of the SafeXml module with the following implementation of a module for safe URL strings:

module SafeUrl (Url, url, renderUrl, module SafeStrings) where
import SafeStrings
import Text.Printf
import Data.Char (ord)

escapeUrl xs =
    concatMap esc xs
  where
    esc x | isReserved x || x > '~' = urlEncode x
          | x == ' '                = "+"
          | otherwise               = [x]

urlEncode x  = '%' : printf "%02x" (ord x)
isReserved   = (`elem` "!#$&'()*+,/:;=?@[]")

$(declareSafeString "url" "Url" [| escapeUrl |])

The final line generates the boilerplate code for the wrapper type, the language definition, the Url type synonym, and the url and renderUrl language-specific convenience functions.

One big example to wrap things up

Because we have been discussing mainly library code, let’s take a step back and see some typical user-level code that uses safe strings. After all, that’s what counts.

Here is a Haskellized, safe-strings version of the Ruby (on Rails) code that I presented at the beginning of the article to add submit-to-Reddit and submit-to-del.icio.us buttons to my blog:

module Example where
import List (intersperse, break)
import SafeXml
import SafeUrl

type Xhtml = Xml

submit_this_article_links :: Article -> Xhtml
submit_this_article_links (Article title url) =
    cat . intersperse nbsp $ do
    (submit_title, submit_url :: Url, image_tag) <- site_list
    return $(q
      "<a href=\"#{r submit_url}\" \
         \title=\"#{submit_title}: &#x201C;#{title}&#x201D;\" \
        \>#{=image_tag}</a>" )

  where

    nbsp = xml "&#160;"

    site_list = [  -- move me into a database table
      ( "Submit to Reddit.com"
      , $(q "http://reddit.com/submit?url=#{r url}&title=#{title}")
      , image_tag "reddit.gif" "18x18" 0
      ),
      ( "Save to del.icio.us"
      , $(q "http://del.icio.us/post?v=2&url=#{r url}&title=#{title}")
      , image_tag "delicious.gif" "16x16" 0
      ) ]

The code looks fairly similar to the original Ruby code, with the exception of some extra backslashes, courtesy of Haskell’s rather-unfortunate syntax for multi-line string constants. (Perl and Ruby’s <<HERE syntax would be a welcome addition.)

The other big difference is that, in this version, the type system has automatically checked the code for strings-problem errors.

For completeness, here is the example’s supporting code (again modeled on Ruby on Rails). This code also makes extensive use of safe-string templates:

image_tag :: String -> String -> Int -> Xhtml
image_tag file_name size border =
    $(q "<img src=\"#{r image_url}\" height=\"#{height}\" \
         \width=\"#{width}\" border=\"#{s border}\"/>")
  where
    image_url         = $(q "#{=site_root}images/#{file_name}")
    (width, _:height) = break (=='x') size

link_to :: Xhtml -> Url -> Xhtml
link_to content url =
    $(q "<a href=\"#{r url}\">#{=content}</a>")

data Article = Article
  { article_title  :: String
  , article_url    :: Url
    -- more fields here
  }

sample_article =
    Article "I love chunky bacon!" $
    url "http://blog.moertel.com/permalink/to/article"

site_root :: Url
site_root =  url "http://blog.moertel.com/"

Have we done it? Have we learned anything?

Have we rid ourselves of the strings problem? If we use a programming language like Haskell and a library like SafeStrings, I think we can answer yes.

To be clear, the fundamental problem of having to manage different kinds of strings is still with us. As programmers, we still must understand the differences between URLs, XML, SQL, untrusted user input, and so on. But now, we don’t have to be perfect. As long as we can reliably slap the right type on a string when it first appears, we can let the computer worry about it from then on. If we forget to escape the string later, as it winds its way through the twisty code of a large web application and interacts with other strings in potentially dangerous ways, the computer will catch our mistake – at compile time, before it can possibly become a live security hole.

But if slapping the right types on strings – certifying them – is a pain in the neck, we won’t do it. We will happily go back to our days of winging it, where every string interaction becomes an opportunity for a perfectly human mistake to give birth to a nasty security vulnerability.

That’s why syntax matters. That’s why Template Haskell, Lisp macros, and other meta-programming tools are important: they let us craft friendly syntaxes that encourage the use of programming aids like SafeStrings. That’s why type inferencing is important: it lets us do away with redundant annotations and makes working with types convenient, so we can reap the benefits of strong guarantees without having to pay prohibitive costs.

If there is a moral to this story, it’s that modern type systems and macro systems are powerful tools. They let us do things that otherwise would be impractically inconvenient. They extend our reach as programmers and let us solve problems that we couldn’t solve before. Why, then, do so many programmers dismiss these tools as mere academic curiosities? Why do so many programmers turn away to fight unaided against, and frequently lose to, the very problems that these tools could so easily solve?

Update: minor edits for clarity.

Solving the Google Code Jam "countPaths" problem in Ruby

Tom Moertel — Wed, 16 Aug 2006 18:54:00 -0400

Here’s a Ruby version of a dynamic-programming-based solver for the Google Code Jam “countPaths” problem. It is essentially the same as my earlier Haskell-based solution (see Update 2), but much slower. Whereas the Haskell version solves the maximum-size, all-the-same-letter problem in about 0.9 second, the Ruby version requires about 71 seconds. Maybe somebody who understands Ruby’s internals better than I do can come up with some optimizations.

Here’s the code:

# Tom Moertel <tom@moertel.com>
# 2006-08-16
#
# Ruby-based solution to the Google Code Jam problem "countPaths" 
# See http://www.cs.uic.edu/~hnagaraj/articles/code-jam/ for more.

class WordPath

  include Enumerable

  def initialize(grid, word)
    @grid, @rword, @counts = grid, word.reverse, {}
  end

  def self.count_paths(grid, word)
    new(grid, word).solve
  end

  def solve
    final_index = @rword.length - 1
    inject(0) { |sum, rc| sum + count_from(final_index, *rc) }
  end

  private

  def count_from(i, r, c)
    @counts[[r, c, i]] ||= begin
      match = @rword[i] == @grid[r][c]
      case
        when i == 0 && match then 1
        when match then subsum_of_neighbors(r, c, i - 1)
        else 0
      end
    end
  end

  def subsum_of_neighbors(r, c, i)
    sum = 0
    rowlen = @grid[0].size
    for nr in [r - 1, r, r + 1]
      next if nr < 0 or nr >= @grid.size
      for nc in [c - 1, c, c + 1]
        next if nc < 0 || nc >= rowlen
        next unless r != nr || c != nc
        if count = count_from(i, nr, nc)
          sum += count
        end
      end
    end
    sum
  end

  def each
    @grid.each_index do |r|
      @grid[0].size.times { |c| yield([r, c]) }
    end
  end

end

# TESTS

if ENV["TEST"] || ENV["BIG_TEST"]

  require "test/unit" 

  class TestWordPath < Test::Unit::TestCase

    if ENV["BIG_TEST"]
      def test_big_problem
        assert_equal \
          303835410591851117616135618108340196903254429200,
          WordPath.count_paths(["A"*50] * 50, "A"*50)
      end
    end

    if ENV["TEST"]
      def test_count_paths
        w = WordPath
        assert_equal 1,
          w.count_paths(%w{ABC FED GHI}, "ABCDEFGHI")
        assert_equal 2,
          w.count_paths(%w{ABC FED GAI}, "ABCDEA")
        assert_equal 0,
          w.count_paths(%w{ABC DEF GHI}, "ABCD")
        assert_equal 108,
          w.count_paths(%w{AA AA}, "AAAA")
        assert_equal 56448,
          w.count_paths(%w{ABABA BABAB ABABA BABAB ABABA}, "ABABABBA")
        assert_equal 2745564336,
          w.count_paths(%w{AAAAA AAAAA AAAAA AAAAA AAAAA}, "AAAAAAAAAAA")
        assert_equal 0,
          w.count_paths(%w{AB CD}, "AA" )
        assert_equal 1,
          w.count_paths(%w{A}, "A")
      end
    end

  end

end

Set the BIG_TEST and/or TEST environment variables to run the test suites. For example:

$ TEST=1 ./countpaths.rb

Loaded suite countpaths
Started
.
Finished in 0.02062 seconds.

1 tests, 8 assertions, 0 failures, 0 errors

Unless somebody beats me to it, I’ll whip up a Perl version for comparison.

Update: I managed to speed up my code by a factor of 17. Now the execution time for the maximum-size, all-the-same-letter problem is down to 4.2 seconds, which is comparable with implementations in other languages. Ivan Peev’s Python implementation, for example, is only slightly faster at 2.8 seconds.

A performance killer in the previous version was using a single big hash for my cache. Now I use a 3D array:


counts[[i,r,c]]   # one big hash (slower)
counts[i][r][c]   # 3D-array (faster)

An additional advantage of the 3D-array is that I can peel off slabs as I descend the outer layers of nested loops. For instance, instead of writing:

for i in 0 .. 10
  for j in 0 .. 10
    sum += counts[i][j]
  end
end

I can lift the counts[i] slab out of the inner loop to eliminate j array-indexing operations:

for i in 0 .. 10
  slab = counts[i]
  for j in 0 .. 10
    sum += slab[j]
  end
end

Here’s the new code (sans the unit tests, which haven’t changed):

class WordPath

  A = Array

  def self.count_paths(grid, word)

    rword  = word.reverse
    rowmax = grid.size - 1
    colmax = grid.first.size - 1

    for i in 0 .. rword.size - 1
      letter = rword[i]
      previous_slab, slab = slab, A.new(rowmax+1) { A.new(colmax+1) }
      for r in 0 .. rowmax
        row, line = grid[r], slab[r]
        for c in 0 .. colmax
          line[c] = unless letter == row[c]
            0
          else
            if i == 0
              1
            else
              sum = 0
              clo = c > 0 ? c - 1 : c
              chi = c < colmax ? c + 1 : c
              for nr in (r > 0 ? r - 1 : r) .. (r < rowmax ? r + 1 : r)
                for nc in clo .. chi
                  sum += previous_slab[nr][nc] if nr != r || nc != c
                end
              end
              sum
            end
          end
        end
      end
    end

    sum = 0
    for r in 0 .. rowmax
      for c in 0 .. colmax
        sum += slab[r][c]
      end
    end

    sum

  end
end

Update 2: I tweaked the code snippet above to remove a variable that I just noticed wasn’t actually doing anything.

Composing functions in Ruby

Tom Moertel — Fri, 07 Apr 2006 11:55:00 -0400

One of the things I miss when coding in Ruby is inexpensive function composition. In Haskell, for example, I can compose functions using the dot (.) operator:

inc        = (+1)
twice      = (*2)
twiceOfInc = twice . inc

Because of Ruby’s open classes, however, I can easily add the feature to the language. In the code below, I introduce Proc.compose and overload the star (*) operator for the purpose:

# func_composition.rb
class Proc
  def self.compose(f, g)
    lambda { |*args| f[g[*args]] }
  end
  def *(g)
    Proc.compose(self, g)
  end
end

And that’s all it takes:

$ irb --simple-prompt -r func_composition.rb

>> inc = lambda { |x| x + 1 }
=> #<Proc:0x00002aaaaaad7810@(irb):1>

>> twice = lambda { |x| x * 2 }
=> #<Proc:0x00002aaaaabd2d18@(irb):2>

>> inc[1]
=> 2

>> twice[2]
=> 4

>> twice_of_inc = twice * inc
=> #<Proc:0x00002aaaaab32458@./func_composition.rb:3>

>> twice_of_inc[1]
=> 4

>> twice_of_inc[2]
=> 6

Now, isn’t that refreshing?

Update: Vincent Foley pointed out on comp.lang.ruby that Ruby Facets has a nearly identical implementation that also uses the star operator for composition. (Its version of compose, however, is an instance method whereas my version is a class method.)

Improving Typo's spam protection

Tom Moertel — Mon, 16 Jan 2006 01:34:00 -0500

I noticed that my site has been picking up more comment spam recently. Typo has built-in spam protection, but for some reason a few spam comments that ought to have been caught slipped through its filters. Curious, I investigated.

Most spam comments contain links to sites favored by the spammers. The sites are almost always of the form x.domain.com, where domain is one of a few higher-level domains and x is drawn from a large set of values from the realms of gambling, pornography, and male enhancement. It seems that the spammers pay for a few real domains and then create a ton of subdomains under them.

One of the ways to detect comment spam is to find URIs in comments and look up the sites they point to in DNS-based SURBLs, such as multi.surbl.org and bsb.empty.us. The thing is, when SURBLs list a spammy site x.domain.com, sometimes they list it under the full hostname x.domain.com and sometimes they list it under the higher-level domain domain.com. To be safe, Typo looks up both forms when it checks for spam.

Here’s the code it uses:

HOST_RBLS.each do |rbl|
  begin
    if [
        IPSocket.getaddress([host, rbl].join('.')),
        IPSocket.getaddress((domain + [rbl]).join('.'))
       ].include?("127.0.0.2")
      throw :hit, "#{rbl} positively resolved #{domain.join('.')}"
    end
  rescue SocketError
  end
end

The code iterates over the list of SURBLs it has and queries each twice – once for the host and once for the domain in question – saving the results of the queries in an array. Then if the array includes a positive response (127.0.0.2), it throws a “hit” notice to the calling code, which will block the associated comment.

Unfortunately, the code doesn’t quite work as intended. Although a positive response for either the host or the domain should register as a hit, the code requires both queries to return positive responses. As a result, the code yields a lot of false negatives because most lists don’t include both host and domain forms of spammy sites; the required double positive is thus hard to obtain.

The cause of the problem is the attempt to query for both forms of the site before checking either response. The queries are performed by calling IPSocket.getaddress, which performs a DNS query for the “A” record associated with its argument. If the record exists, the call returns it; otherwise, the call raises a SocketError exception.

The exception is what causes the logic to break down. When either the host or domain is not in the queried SURBL, which will almost always be the case for reasons I explained earlier, one of the queries will result in a SocketError exception. The exception will be caught by the rescue clause later in the code, but not before the opportunity to test the other query’s response and throw a “hit” has been lost.

My fix was to replace the above code with a call to a new helper method:

query_rbls(HOST_RBLS, host, domain.join('.'))

The helper, defined later, makes the actual queries:

def query_rbls(rbls, *subdomains)
  rbls.each do |rbl|
    subdomains.uniq.each do |d|
      begin
        response = IPSocket.getaddress([d, rbl].join('.'))
        throw :hit, "#{rbl} positively resolved #{d} => #{response}"
      rescue SocketError
        # NXDOMAIN response => negative:  d is not in RBL
      end
    end
  end
  return false
end

Because some SURBLs don’t use 127.0.0.2 but some other “A” record to indicate a positive response, my helper removes the hard-coded address test.

I also made a few more improvements to the spam-protection code. The full set of changes is available as Patch 657 on the Typo Trac site.