using Programming;

A Blog about some of the intrinsics related to programming and how one can get the best out of various languages.

Constructing an IMAP Server from Scratch - Part 2

Implementing Server-Side RFC 3501 (IMAP) in F# (Part 2)

Previous: Implementing Server-Side RFC 3501 (IMAP) in F# (Part 1)

Alright, so the previous blog post got us introducded to our RFC 3501 (IMAP) implementation. We looked at the basic TCP/IP stack of the architecture. Today, we're going to actually start building part of the IMAP server itself.

To start building the IMAP server, we need to start building a mock file-system. Now me, personally, I'm about keeping things as simple as possible. As a result, the mock file-server I'm building is not going to do anything fancy. We'll use a DemoFiles folder in the IMAP server for all the data, then within that folder we'll have a Configuration file, then a Message_{Id} file for each message. The Configuration file will have some basic stuff:

  • Password: to verify the user against on authentication;
  • UIDVALIDITY: that value that RFC 3501 says can never change;
  • NextUniqueIdentifier: the value that RFC 3501 dictates must change only when a message is received;

Next, each Message_{Id} file needs to have a few of it's own pieces:

  • Attributes: at least all of the following attributes:
    • \Seen
    • \Answered
    • \Flagged
    • \Deleted
    • \Draft
  • Date/Time Received: the date and time that the message was received by the server (typically via SMTP);
  • Message Size: the number of 8-bit octets in the message;
  • Envelope Structure: the parsed header of the message;
  • Body Structure: the parsed body (MIME-IME) of the message;
  • Message Text: the text(s) in the message;

We'll worry about messages later, for now I just want to concern ourselves with the configuration, as that's the first part of implementing IMAP.

Building a Configuration File

Now we have several methods for building the configuration file: XML, JSON, INI, CSV, etc. Because I'm lazy, and because this is a sample storage system, I'm going to build it as a line-delimited file. I.e.: each line is a value in the config. (Easy to write by hand, easy to ready by hand, easy to parse with code, all-in-all, pretty easy.)

Our config file will look like:

Plaintext Password (For easy troubleshooting)
The UIDVALIDITY value (Constant)
The Next Unique Identifier value (Changes when a message comes in)

My sample configuration:

Password123
307110933
1

Building Storage Events

Using this basic configuration, we can start to modify our server to take note of file read/write. We can start modifying the IMAP server to start using some storage events.

type StorageEvents =
    { Authenticate : string * string -> User option
      GetUidValidity : User -> int
      GetNextUniqueId : User -> int }

So we can start developing some basic events here. We want to be able to tell if a user can be authenticated (take a username and password and output a Some User if it's valid, or None if not). We want to get the UIDVALIDITY value (take a User and return an int), and we want to get the next unique ID (take a User and output an int).

Now we don't really take commands from the server yet, but we can shoehorn a test or two in:

let objectToStr o = o.ToString()
let rec runClient (socket : Socket) =
    let printfn = printfn "Socket %s: %s" (socket.RemoteEndPoint.ToString())
    let user = Some { Id = "ebrown@example.com" }
    async {
        let! buffer = () |> socket.AsyncReceiveAll
        let str = buffer |> Encoding.ASCII.GetString
        sprintf "Received (%i bytes): %s" buffer.Length str |> printfn
        if str.Length = 3 && str = "BYE" then printfn "Disconnected"
        else
            let! bytesSent = [| "Hello, other world!"B |> Some; user |> Option.map (storageEvents.GetUidValidity >> objectToStr >> Seq.map byte >> Seq.toArray) |] |> Array.choose id |> Array.concat |> socket.AsyncSend
            bytesSent |> sprintf "Sent response (%i bytes)" |> printfn
            return! socket |> runClient }

We'll send back the UIDVALIDITY value every time we get a packet from a client, that should be a good proof-of-concept.

Our server itself needs to change (ever-so-slightly): type Server (storageEvents) =, this will allow us to pass the storageEvents in, and the server has no idea what or how the underlying storage mechanism works (nor does it care).

Defining the entire storage system to work is really, really trivial:

type Configuration =
    { Password : string
      UidValididty : int
      NextUniqueId : int }
let getConfig (f : string) =
    let lines = System.IO.Path.Combine(@"DemoFiles", f, @"Configuration.txt") |> System.IO.File.ReadAllLines
    { Password = lines.[0]; UidValididty = lines.[1] |> int; NextUniqueId = lines.[2] |> int }
let serverEvents = 
    { Authenticate = (fun (u, p) -> if (u |> getConfig).Password = p then Some { Id = u } else None)
      GetUidValidity = (fun u -> (u.Id |> getConfig).UidValididty)
      GetNextUniqueId = (fun u -> (u.Id |> getConfig).NextUniqueId) }

We defined a Configuration type, a function to parse it, and then created a serverEvents object to hold all the functions for working with the storage system. Our main function changes little:

use server = Server(serverEvents).Start()
Console.ReadLine() |> ignore
printfn "Closing..."
0

We just put serverEvents in now.

If we put it all together to start testing it, we'll get Received 28 bytes: Hello, other world!307110933 on the client, which proves that our storage works.

We can push this off to a Storage module, to get it out of our work-area:

module EBrown.Imap.Server.Storage
open EBrown.Imap.Core

type Configuration =
    { Password : string
      UidValididty : int
      NextUniqueId : int }
let getConfig (f : string) =
    let lines = System.IO.Path.Combine(@"DemoFiles", f, @"Configuration.txt") |> System.IO.File.ReadAllLines
    { Password = lines.[0]; UidValididty = lines.[1] |> int; NextUniqueId = lines.[2] |> int }
let getStorageEvents () = 
    { Authenticate = (fun (u, p) -> if (u |> getConfig).Password = p then Some { Id = u } else None)
      GetUidValidity = (fun u -> (u.Id |> getConfig).UidValididty)
      GetNextUniqueId = (fun u -> (u.Id |> getConfig).NextUniqueId) }

Implementing IMAP Commands

Alright, so now that we have a storage mechanism, we want to start implementing some IMAP commands and state and such.

IMAP commands are either tagged or untagged, and comprise of a command name, and possibly arguments. Thus a command would look like <TAG> <COMMANDNAME> <ARGUMENTS>, where <TAG> is either a client-generated string, or a * if the command is untagged. There are a few, basic commands, that can be implemented regardless of the state of the IMAP connection:

  • CAPABILITY: the capability command is tagged and has no arguments. The response should be one untagged response with a list of what capabilities are currently supported by the server, and the server should send one tagged OK response (or a tagged BAD response if the command is badly formed).
  • NOOP: the noop command is tagged and has no arguments. There is no specific response, but it can be used as a polling command as any command can return a status update. The server should send one tagged OK (or BAD) response after sending status update data, if appropriate.
  • LOGOUT: the logout command is tagged and has no arguments. The response should be one untagged BYE, and one OK or BAD.

The format of an OK response to a command is <TAG> OK <COMMANDNAME> completed.

Thus, if a client sends a a002 NOOP, the server OK response would be a002 OK NOOP completed.

With all this in mind, we can start building a command parser and generator.

The first part we need is a Tag. This is honestly quite trivial:

type Tag = | Untagged | Tagged of string
let getTag = function | Untagged -> "*" | Tagged s -> s

As commands are either tagged or untagged, this makes life really easy.

Next, we need a general generateLine, which can be used to generate any given command or response:

let joinStrings (sep : string) (sarr : string array) = System.String.Join(sep, sarr)
let generateLine tag largs name rargs =
    [|[|tag |> getTag |> Some|]; largs; [|name |> Some|]; rargs|]
    |> Array.concat
    |> Array.choose id
    |> joinStrings " "

We generalize this enough so that we can use it for any command, which makes life extremely trivial to build a generateCommand:

let generateCommand tag name args = generateLine (Tagged tag) [||] name (args |> Array.map Some)

Now we can generalize command generation, let's build a capability command:

let capability tag = generateCommand tag "CAPABILITY" [||]
let capabilityResponse tag args = [|generateLine Untagged [||] "CAPABILITY" (args |> Array.map Some); generateLine (Tagged tag) [|"OK" |> Some|] "CAPABILITY" [|"completed" |> Some|]|]

Again, we're keeping it mostly simple.

The next step is to parse a command. This will be just as easy as generation, we'll define new types and a function to handle the input.

type Command = | Capability
type InputCommand = { Tag : Tag; Command : Command }
let parseCommand (command : string) =
    let parseTag = function | "*" -> Untagged | s -> Tagged s
    let parseCommandName =
        function
        | [|"CAPABILITY"|] -> Capability |> Some
        | _ -> None
    let parts = command.Split(' ')
    parts.[1..] |> parseCommandName |> Option.map (fun c -> { Tag = parts.[0] |> parseTag; Command = c })

Again, quite simple. We parse the tag out, then we parse the command out, and return the result.

So with this, extending to add a NOOP command is really easy:

type Command = | Capability | Noop
....
let noop tag = generateCommand tag "NOOP" [||]
let noopResponse tag = [|generateLine (Tagged tag) [||] "NOOP" [|"completed" |> Some|]|]
....
let parseCommand (command : string) =
    let parseTag = function | "*" -> Untagged | s -> Tagged s
    let parseCommandName =
        function
        | [|"CAPABILITY"|] -> Capability |> Some
        | [|"NOOP"|] -> Noop |> Some
        | _ -> None
    let parts = command.Split(' ')
    parts.[1..] |> parseCommandName |> Option.map (fun c -> { Tag = parts.[0] |> parseTag; Command = c })

And now we have NOOP support.

Lastly, LOGOUT command support:

let logout tag = generateCommand tag "LOGOUT" [||]
let logoutResponse tag = [|generateLine Untagged [||] "BYE" ([|"IMAP4rev1"; "Server"; "logging"; "out"|] |> Array.map Some); generateLine (Tagged tag) [||] "LOGOUT" [|"completed" |> Some|]|]
let parseCommand (command : string) =
    let parseTag = function | "*" -> Untagged | s -> Tagged s
    let parseCommandName =
        function
        | [|"CAPABILITY"|] -> Capability |> Some
        | [|"NOOP"|] -> Noop |> Some
        | [|"LOGOUT"|] -> Logout |> Some
        | _ -> None
    let parts = command.Split(' ')
    parts.[1..] |> parseCommandName |> Option.map (fun c -> { Tag = parts.[0] |> parseTag; Command = c })

Now as we work with this, we should realize that we can actually remove most of the specific functions, and use the InputCommand for the capability, noop, and logout functions we built:

type ClientCommandName = | Capability | Noop | Logout
type ClientCommand = { Tag : Tag; Command : ClientCommandName }
let generateClientCommandName =
    function
    | Capability -> ("CAPABILITY", [||])
    | Noop -> ("NOOP", [||])
    | Logout -> ("LOGOUT", [||])
let generateClientCommand (command : ClientCommand) = command.Command |> generateClientCommandName ||> generateLine command.Tag [||]
let parseClientCommand (command : string) =
    let parseTag = function | "*" -> Untagged | s -> Tagged s
    let parseCommandName =
        function
        | [|"CAPABILITY"|] -> Capability |> Some
        | [|"NOOP"|] -> Noop |> Some
        | [|"LOGOUT"|] -> Logout |> Some
        | _ -> None
    let parts = command.Split(' ')
    parts.[1..] |> parseCommandName |> Option.map (fun c -> { ClientCommand.Tag = parts.[0] |> parseTag; Command = c })

type OkBadResult = | Ok | Bad
let getOkBad = function | Ok -> ("OK", "completed") | Bad -> ("BAD", "")
type ServerCommandName = | Capability of OkBadResult * string array | Noop of OkBadResult | Logout of OkBadResult
type ServerCommand = { Tag : Tag; Command : ServerCommandName }
let generateServerCommandName (command : ServerCommand) =
    match command.Command with 
    | Capability (res, options) ->
        let lRes, rRes = res |> getOkBad
        [|(Untagged, [||], "CAPABILITY", options); (command.Tag, [|lRes|], "CAPABILITY", [|rRes|])|]
    | Noop res ->
        let lRes, rRes = res |> getOkBad
        [|command.Tag, [|lRes|], "NOOP", [|rRes|]|]
    | Logout res ->
        let lRes, rRes = res |> getOkBad
        [|(Untagged, [||], "BYE", [|"IMAP4rev1 Server logging out"|]); command.Tag, [|lRes|], "LOGOUT", [|rRes|]|]
let generateServerCommand (command : ServerCommand) = command |> generateServerCommandName |> Array.map (fun (t, l, n, r) -> generateLine t (l |> Array.map Some) n (r |> Array.map Some))

So now we have a manner of building commands, somewhat dynamically. We can construct a command from what it needs, which means we can continue on with the next step: authentication / authorization. That will be the subject of the next blog post, as I want to allow a lot of this to sink in, so that we can hit the ground running in the next situation. We have a whole hell-of-a-lot to do yet, so we'll take it in shorter, more manageable bits.


As a reminder, the code for this is on GitHub. The version for this specific blog post is tree 8d7b3f15777d0be7cd78903bb5f0c94d8175230d.


Due to time constraints, I didn't make it as far as I would have liked with this post. But never fear, consistent, slow progress is better than inconsistent progress.

Loading