diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c) 2016, Adam Wick
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Adam Wick nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/halvm-web.cabal b/halvm-web.cabal
new file mode 100644
--- /dev/null
+++ b/halvm-web.cabal
@@ -0,0 +1,34 @@
+name:                halvm-web
+version:             0.3.0.0
+synopsis:            A simple, static HaLVM web server
+description:         A simple, static HaLVM web server
+homepage:            http://halvm.org
+license:             BSD3
+license-file:        LICENSE
+author:              Adam Wick
+maintainer:          awick@galois.com
+copyright:           2016, Adam Wick
+category:            Web
+build-type:          Simple
+cabal-version:       >=1.10
+
+executable halvm-web
+  main-is:             Main.hs
+  other-modules:       Network.HTTP.Streams
+  other-extensions:    MultiWayIf
+  build-depends:       async       >= 2.1.0    && < 2.3.0,
+                       base        >= 4.7      && < 4.8,
+                       bytestring  >= 0.10.4   && < 0.12.0,
+                       cereal      >= 0.5.3    && < 0.8,
+                       containers  >= 0.5.5.1  && < 0.8,
+                       HALVMCore   >= 2.0.0    && < 2.2.0,
+                       hans        >= 3.0.1    && < 3.4.0,
+                       HTTP        >= 4000.3.3 && < 4002.0.0,
+                       mime-types  >= 0.1.0.7  && < 0.4,
+                       network-uri >= 2.6.1.0  && < 2.9,
+                       simple-tar  >= 0.5      && < 0.9,
+                       text        >= 1.2.2.1  && < 1.5,
+                       XenDevice   >= 2.0.0    && < 2.2.0
+  hs-source-dirs:      src
+  ghc-options:         -Wall
+  default-language:    Haskell2010
diff --git a/src/Main.hs b/src/Main.hs
new file mode 100644
--- /dev/null
+++ b/src/Main.hs
@@ -0,0 +1,225 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards   #-}
+import           Codec.Archive.Tar(Archive, ArchiveMember(..), unarchive,
+                                   regContents, linkTarget)
+import           Control.Concurrent(threadDelay, forkIO)
+import           Control.Concurrent.Async(Async, async, waitAny)
+import           Control.Exception(SomeException, handle)
+import           Control.Monad(void, forever, forM_, foldM)
+import qualified Data.ByteString as S
+import           Data.ByteString(ByteString)
+import qualified Data.ByteString.Char8 as C
+import           Data.ByteString.Unsafe(unsafePackCStringLen)
+import           Data.Char(toLower)
+import qualified Data.Map.Strict as Map
+import           Data.Serialize.Get(runGet, getWord32host)
+import           Data.Text(pack, unpack)
+import           Data.Text.Encoding(decodeUtf8)
+import           Foreign.Ptr(castPtr, nullPtr)
+import           Hans(newNetworkStack, addDevice, startDevice, processPackets,
+                       defaultConfig)
+import           Hans.Device(Device(..), listDevices, defaultDeviceConfig)
+import           Hans.IP4.Packet(IP4, showIP4)
+import           Hans.IP4.Dhcp.Client(DhcpLease(..), DhcpConfig(..), dhcpClient,
+                                      defaultDhcpConfig)
+import           Hans.Addr(NetworkAddr, toAddr, showAddr)
+import           Hans.Lens(view)
+import           Hans.Socket(TcpListenSocket, sListen, sAccept,
+                             tcpRemoteAddr, defaultSocketConfig)
+import           Hypervisor.Console(Console, initXenConsole, writeConsole)
+import           Hypervisor.DomainInfo(domainModuleStart, domainModuleLength,
+                                       DomainFlags(..), domainFlags)
+import           Hypervisor.XenStore(initXenStore)
+import           Network.HTTP(Request(..), Response(..), ResponseCode)
+import           Network.HTTP.Headers(HeaderName(..), retrieveHeaders, mkHeader,
+                                      hdrValue)
+import           Network.HTTP.Stream(Stream(..), receiveHTTP, respondHTTP)
+import           Network.HTTP.Streams()
+import           Network.Mime(mimeByExt, defaultMimeMap, defaultMimeType)
+import           Network.URI(URI(..))
+
+main :: IO ()
+main =
+  do con <- initXenConsole
+     handle (handleErr con "at top level") $
+       do disks   <- getRamdisk con
+          archive <- foldM (unarchiveAndMerge con) Map.empty disks
+          xs      <- initXenStore
+          nics    <- listDevices xs
+          ns      <- newNetworkStack defaultConfig
+          devs    <- mapM (\ n -> addDevice xs ns n defaultDeviceConfig) nics
+          -- make hans go!
+          void $ forkIO $ handle (handleErr con "packet processor") $
+                            processPackets ns
+          forM_ devs startDevice
+          -- get our addresses and start our web servers
+          writeConsole con ("Found " ++ show (length devs) ++ " devices.\n")
+          leases <- mapM (\ d -> async $ handle (handleErr con "dhcp client") $
+                           do writeConsole con ("Starting DHCP client for " ++ show (devMac d) ++ "\n")
+                              l <- dhcpClient ns (manyRetriesConfig con) d
+                              writeConsole con ("Picked up DHCP lease for " ++ show (devMac d) ++ "\n")
+                              return (l, d)) devs
+          writeConsole con ("Generated " ++ show (length leases) ++ " leases.\n")
+          processAsyncs leases $ \ (mlease, dev) ->
+            case mlease of
+              Nothing ->
+                writeConsole con ("Device " ++ show (devMac dev) ++
+                                  " failed to get an address.\n")
+              Just lease ->
+                do let addr = dhcpAddr lease
+                   writeConsole con ("Starting listener on " ++ showIP4 addr ""
+                                     ++ " (dev " ++ show (devMac dev) ++ ")\n")
+                   lsock <- sListen ns defaultSocketConfig addr 80 5
+                   void $ forkIO $
+                     handle (handleErr con ("on socket for " ++ showIP4 addr "")) $
+                       do writeConsole con ("Started on "++showIP4 addr ""++":80\n")
+                          forever $ do sock <- sAccept (lsock :: TcpListenSocket IP4)
+                                       let r = view tcpRemoteAddr sock
+                                       handleClient con (handleReq con archive r) sock
+          writeConsole con ("Known keys:\n")
+          writeConsole con ("-----------------------------------------------\n")
+          forM_ (Map.keys archive) (\ k -> writeConsole con (show k ++ "\n"))
+          writeConsole con ("-----------------------------------------------\n")
+          forever (threadDelay (15 * 1000 * 1000))
+
+unarchiveAndMerge :: Console -> Archive -> (String, ByteString) -> IO Archive
+unarchiveAndMerge con acc (name, bstr) =
+  case unarchive bstr of
+    Left err ->
+      do writeConsole con (show (S.length bstr) ++
+                           " byte archive failed to expand: "
+                           ++ err ++ "\n")
+         return acc
+    Right archive ->
+      do writeConsole con (show (S.length bstr) ++ " byte archive " ++ name ++
+                           " unarchived.\n")
+         return (archive `Map.union` acc)
+
+processAsyncs :: [Async a] -> (a -> IO ()) -> IO ()
+processAsyncs [] _ = return ()
+processAsyncs ls process =
+  do (asyncx, x) <- waitAny ls
+     process x
+     processAsyncs (filter (/= asyncx) ls) process
+
+handleErr :: Console -> String -> SomeException -> IO a
+handleErr con place e =
+  do writeConsole con ("Caught exception " ++ place ++ ": ")
+     writeConsole con (show e ++ "\n")
+     threadDelay (10 * 1000 * 1000)
+     fail "handleErr"
+
+data Result = Result {
+       _resCode :: ResponseCode
+     , _resKind :: String
+     , _resBody :: ByteString
+     }
+
+handleReq :: NetworkAddr addr =>
+             Console -> Archive ->
+             addr -> Request String ->
+             IO Result
+handleReq con archive fromAddr req =
+  go ("site" ++ uriPath (rqURI req)) (2,0,0) $
+    go ("site/404.html") (4,0,4) $
+      return (Result (4,0,4) "text/html" builtin404)
+ where
+  go "site/" code otherwiseDo =
+    go "site/index.html" code otherwiseDo
+  go key code otherwiseDo = putStrLn ("go " ++ key ++ " " ++ show code ++ "\n") >>
+    case Map.lookup key archive of
+      Just (RegularFileMember rfile) ->
+        do let mimeType = mimeByExt defaultMimeMap defaultMimeType (pack key)
+               mimeType' = unpack (decodeUtf8 mimeType)
+           writeConsole con ("Request for " ++ key ++ " (" ++ mimeType' ++
+                             ") from " ++ showAddr (toAddr fromAddr) "")
+           return (Result code mimeType' (regContents rfile))
+      Just (LinkMember link) ->
+        go (linkTarget link) code otherwiseDo
+      Just (SymbolicLinkMember link) ->
+        go (linkTarget link) code otherwiseDo
+      Nothing ->
+        putStrLn ("Nothing found. (" ++ key ++ ")") >> otherwiseDo
+      _ ->
+        otherwiseDo
+
+builtin404 :: ByteString
+builtin404 =
+  "<html><head><title>Nope</title></head><body><h1>Page not found!</h1></body>"
+
+getRamdisk :: Console -> IO [(String, ByteString)]
+getRamdisk con =
+  do start <- domainModuleStart
+     case start of
+       Left ptr | ptr == nullPtr ->
+         do writeConsole con "ERROR: Could not load ramdisk.\n"
+            return []
+       Left ptr ->
+         do len <- domainModuleLength
+            res <- unsafePackCStringLen (castPtr ptr, fromIntegral len)
+            dflags <- domainFlags
+            writeConsole con "Parsing multiboot record.\n"
+            if DomainModuleIsMultiboot `elem` dflags
+              then return (processMultiboot res)
+              else return [("", res)]
+       Right _ ->
+         do writeConsole con "ERROR: Got PFN from ramdisk; need to fix?\n"
+            return []
+
+processMultiboot :: ByteString -> [(String, ByteString)]
+processMultiboot bstr =
+  case runGet getHeaders bstr of
+    Left  _  -> []
+    Right xs -> xs
+ where
+  getHeaders =
+    do modStart   <- fromIntegral `fmap` getWord32host
+       modEnd     <- fromIntegral `fmap` getWord32host
+       cmdLineOff <- fromIntegral `fmap` getWord32host
+       _          <- getWord32host
+       let cmdLine = C.unpack (S.takeWhile (/= 0) (S.drop cmdLineOff bstr))
+           modl    = S.take (modEnd - modStart + 1) (S.drop modStart bstr)
+       if modStart == 0
+         then return []
+         else ((cmdLine, modl):) `fmap` getHeaders
+
+handleClient :: Stream s =>
+                Console ->
+                (Request String -> IO Result) ->
+                s ->
+                IO ()
+handleClient con buildBody s = void (forkIO (run s))
+ where
+  run :: Stream s => s -> IO ()
+  run sock =
+    do writeConsole con "Getting request from client.\n"
+       mreq <- receiveHTTP sock
+       writeConsole con ("Got request from client: " ++ show mreq ++ "\n")
+       case mreq of
+         Left  err -> writeConsole con ("Request error: " ++ show err ++ "\n")
+         Right req ->
+           do Result rspCode contentType body <- buildBody req
+              let len = show (S.length body)
+                  rspBody = C.unpack body
+                  keepAlive = [ mkHeader HdrConnection "keep-alive"
+                              | hdr <- retrieveHeaders HdrConnection req
+                              , map toLower (hdrValue hdr) == "keep-alive" ]
+                  conn | null keepAlive = [ mkHeader HdrConnection "Close" ]
+                       | otherwise      = keepAlive
+                  rspHeaders = mkHeader HdrContentLength len
+                             : mkHeader HdrContentType   contentType
+                             : conn
+                  rspReason = toReason rspCode
+                  resp = Response { .. }
+              writeConsole con "Sending response.\n"
+              respondHTTP sock resp
+              writeConsole con ("Sent response. (" ++ show conn ++ "\n")
+              if null keepAlive then close sock else run sock
+
+toReason :: ResponseCode -> String
+toReason (2,0,0) = "OK"
+toReason (4,0,4) = "Not Found"
+toReason (_,_,_) = error "No reason found!"
+
+manyRetriesConfig :: Console -> DhcpConfig
+manyRetriesConfig _ = defaultDhcpConfig{ dcRetries = 50000 }
diff --git a/src/Network/HTTP/Streams.hs b/src/Network/HTTP/Streams.hs
new file mode 100644
--- /dev/null
+++ b/src/Network/HTTP/Streams.hs
@@ -0,0 +1,41 @@
+{-# LANGUAGE MultiWayIf #-}
+module Network.HTTP.Streams(
+       )
+ where
+
+import           Control.Concurrent(threadDelay)
+import qualified Data.ByteString.Lazy as BS
+import qualified Data.ByteString.Lazy.Char8 as BSC
+import           Hans.Network(Network)
+import           Hans.Socket(TcpSocket, sClose, sRead, sCanWrite, sWrite)
+import           Network.HTTP.Stream(Stream(..), ConnError(..))
+
+instance Network addr => Stream (TcpSocket addr) where
+  readLine s = loop ""
+   where loop acc =
+           do bstr <- sRead s 1
+              if | BS.null bstr       -> return (Left ErrorClosed)
+                 | BS.head bstr == 10 -> return (Right (acc ++ "\n"))
+                 | otherwise          -> loop (acc ++ BSC.unpack bstr)
+  readBlock s x = loop (fromIntegral x) BS.empty
+    where loop 0 acc = return (Right (BSC.unpack acc))
+          loop y acc =
+            do bstr <- sRead s (fromIntegral y)
+               if | BS.length bstr == y -> loop 0 (acc `BS.append` bstr)
+                  | BS.length bstr == 0 -> return (Left ErrorClosed)
+                  | otherwise           -> loop (y - BS.length bstr)
+                                                (acc `BS.append` bstr)
+  writeBlock s str = loop (BSC.pack str)
+    where loop x | BS.null x = return (Right ())
+                 | otherwise =
+                    do amt <- sWrite s x
+                       if amt == 0
+                         then wait x
+                         else loop (BS.drop (fromIntegral amt) x)
+          wait x = do goodToGo <- sCanWrite s
+                      if goodToGo
+                        then loop x
+                        else threadDelay 500000 >> wait x
+  close s = sClose s
+  closeOnEnd _ _ = return ()
+