Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

port mirage-tutorial to latest interfaces

  • Loading branch information...
commit 6b426ee4a6a17f1394794f77f753080e19e225a6 1 parent b8efbd8
@avsm authored
View
4 .gitignore
@@ -3,4 +3,8 @@ _build
*.img
slides/myocamlbuild.ml
slides/filesystem_static.ml
+slides/main.ml
+slides/setup.data
+slides/setup.log
+*.native
examples/dns/filesystem_static.ml
View
20 slides/Makefile
@@ -1,17 +1,13 @@
-# valid targets for various combinations :
-# run-socket_crunch
-# run-socket_fs
-# run-direct_crunch
-# run-direct_fs
-# run-xen_crunch
-# run-xen_fs
+ifeq ($(MIRAGE_OS),xen)
+FLAGS=--enable-xen --disable-unix
+else
+FLAGS=--enable-unix --disable-xen
+endif
-all: run-socket_crunch
-
-run-%:
- ./scripts/build_$*.sh
+all:
+ ocaml setup.ml -configure $(FLAGS)
+ ocaml setup.ml -build
.PHONY:clean
clean:
- $(RM) filesystem_static.ml myocamlbuild.ml static.img
ocamlbuild -clean
View
37 slides/_oasis
@@ -0,0 +1,37 @@
+OASISFormat: 0.3
+Name: mirage-tutorial
+Version: 0.9.0
+Synopsis: OCaml Tutorial
+Authors: Anil Madhavapeddy, Thomas Gazagnaire, David Scott
+License: ISC
+BuildTools: ocamlbuild
+PostConfCommand: ./gen_main.sh
+PostDistCleanCommand: $rm main.ml
+
+Flag unix
+ Description: build UNIX binary
+ Default: false
+
+Flag xen
+ Description: build Xen binary
+ Default: false
+
+Executable "www.unix"
+ Path: .
+ MainIs: main.ml
+ Build$: flag(unix)
+ Custom: true
+ CompiledObject: native
+ Install: false
+ BuildDepends: mirage, cohttp.mirage, uri, re, cow ( >= 0.3.2)
+
+Executable "www.xen"
+ Path: .
+ MainIs: main.ml
+ Build$: flag(xen)
+ Custom: true
+ Target: xen
+ CompiledObject: native
+ Install: false
+ BuildDepends: mirage, cohttp.mirage, uri, re, cow ( >= 0.3.2)
+
View
30 slides/_tags
@@ -0,0 +1,30 @@
+# OASIS_START
+# DO NOT EDIT (digest: 5a11e28dc623267a5437f01f7417f682)
+# Ignore VCS directories, you can use the same kind of rule outside
+# OASIS_START/STOP if you want to exclude directories that contains
+# useless stuff for the build process
+<**/.svn>: -traverse
+<**/.svn>: not_hygienic
+".bzr": -traverse
+".bzr": not_hygienic
+".hg": -traverse
+".hg": not_hygienic
+".git": -traverse
+".git": not_hygienic
+"_darcs": -traverse
+"_darcs": not_hygienic
+# Executable www.unix
+# Executable www.xen
+<main.{native,nobj.o}>: pkg_mirage
+<main.{native,nobj.o}>: pkg_cohttp.mirage
+<main.{native,nobj.o}>: pkg_uri
+<main.{native,nobj.o}>: pkg_re
+<main.{native,nobj.o}>: pkg_cow
+<*.ml{,i}>: pkg_mirage
+<*.ml{,i}>: pkg_cohttp.mirage
+<*.ml{,i}>: pkg_uri
+<*.ml{,i}>: pkg_re
+<*.ml{,i}>: pkg_cow
+<main.{native,nobj.o}>: custom
+# OASIS_STOP
+<*.ml>: syntax_camlp4o, pkg_lwt.syntax, pkg_cow.syntax
View
6 slides/content.ml
@@ -6,7 +6,7 @@ let rt = ">>"
let header =[ {
styles=[Title];
- content= <:html<
+ content= <:xml<
<h1>Building a Functional Operating System</h1>
<br />
Tutorial T3<br />
@@ -17,7 +17,7 @@ let header =[ {
let p2 = {
styles=[Fill];
- content= <:html<
+ content= <:xml<
<h3>Code</h3>
<section><pre>
<![CDATA[
@@ -43,7 +43,7 @@ let main () =
let footer = [{
styles=[];
- content= <:html<
+ content= <:xml<
<h1>The End
<br /><small>now stand around the watercooler and discuss things</small>
</h1>
View
2  slides/crunch_server.mir
@@ -1,2 +0,0 @@
-Server.main
-Filesystem_static
View
6 slides/gen_main.sh
@@ -0,0 +1,6 @@
+#!/bin/sh -e
+
+mir-crunch -name "static" static > filesystem_static.ml
+echo open Filesystem_static > main.ml
+echo open Server >> main.ml
+echo "let _ = OS.Main.run (main ())" >> main.ml
View
2  slides/kv_ro_server.mir
@@ -1,2 +0,0 @@
-Server.main
-Block.SimpleKV
View
8 slides/scripts/build_direct_crunch.sh
@@ -1,8 +0,0 @@
-#!/bin/bash -e
-
-BIN=crunch_server
-MIR_RUN=$(which mir-run)
-
-mir-crunch -name "static" static > filesystem_static.ml
-mir-build unix-direct/${BIN}.bin
-sudo ${MIR_RUN} -b unix-direct ./_build/unix-direct/${BIN}.bin
View
10 slides/scripts/build_direct_fs.sh
@@ -1,10 +0,0 @@
-#!/bin/bash -e
-
-BIN=kv_ro_server
-MIR_RUN=$(which mir-run)
-
-dd if=/dev/zero of=static.img bs=1024 count=8192
-mir-fs-create static static.img
-
-mir-build unix-direct/${BIN}.bin
-sudo ${MIR_RUN} -b unix-direct -vbd staticvbd:static.img -kv_ro static:staticvbd ./_build/unix-direct/${BIN}.bin
View
8 slides/scripts/build_socket_crunch.sh
@@ -1,8 +0,0 @@
-#!/bin/bash -ex
-
-BIN=crunch_server
-MIR_RUN=$(which mir-run)
-
-mir-crunch -name "static" static > filesystem_static.ml
-mir-build -I src unix-socket/${BIN}.bin
-sudo ${MIR_RUN} -b unix-socket ./_build/unix-socket/${BIN}.bin
View
7 slides/scripts/build_socket_fs.sh
@@ -1,7 +0,0 @@
-#!/bin/bash -e
-
-BIN=kv_ro_server
-MIR_RUN=$(which mir-run)
-
-mir-build unix-socket/${BIN}.bin
-sudo ${MIR_RUN} -b unix-socket -kv_ro static:static ./_build/unix-socket/${BIN}.bin
View
8 slides/scripts/build_xen_crunch.sh
@@ -1,8 +0,0 @@
-#!/bin/bash -e
-
-BIN=crunch_server
-MIR_RUN=$(which mir-run)
-
-mir-crunch -name "static" static > filesystem_static.ml
-mir-build xen/${BIN}.xen
-sudo ${MIR_RUN} -b xen -vif xenbr0 ./_build/xen/${BIN}.xen
View
10 slides/scripts/build_xen_fs.sh
@@ -1,10 +0,0 @@
-#!/bin/bash -ex
-
-BIN=kv_ro_server
-MIR_RUN=$(which mir-run)
-
-dd if=/dev/zero of=static.img bs=1024 count=8192
-mir-fs-create static static.img
-
-mir-build xen/${BIN}.xen
-sudo ${MIR_RUN} -b xen -vif xenbr0 -vbd hda1:static.img -kv_ro static:hda1 ./_build/xen/${BIN}.xen
View
2  slides/server.mir
@@ -1,2 +0,0 @@
-Server.main
-Crunch_fs
View
39 slides/server.ml
@@ -14,40 +14,35 @@ let get_file filename =
OS.Devices.with_kv_ro "static" (fun kv_ro ->
match_lwt kv_ro#read filename with
|None -> return None
- |Some k -> Bitstring_stream.string_of_stream k >|= (fun x -> Some x)
+ |Some s ->
+ lwt x = Lwt_stream.to_list s >|= Cstruct.copy_buffers in
+ return (Some x)
)
+
+module CL = Cohttp_lwt_mirage
+module C = Cohttp
let main () =
- Log.info "Server" "listening to HTTP on port %d" port;
- let callback conn_id req =
- printf "%s\n%!" (Http.Request.path req);
- match_lwt get_file (Http.Request.path req) with
+ let callback conn_id ?body req =
+ printf "%s\n%!" (CL.Request.path req);
+ match_lwt get_file (CL.Request.path req) with
|Some body ->
- Http.Server.respond ~body ()
+ CL.Server.respond_string ~status:`OK ~body ()
|None ->
- if Http.Request.path req = "/" then (
- let headers = ["content-type","text/html"] in
+ if CL.Request.path req = "/" then (
+ let headers = C.Header.init_with "content-type" "text/html" in
let body = Content.body in
- Http.Server.respond ~body ~headers ()
+ CL.Server.respond_string ~status:`OK ~body ~headers ()
) else
- Http.Server.respond_not_found ~url:(Http.Request.path req) ()
+ CL.Server.respond_not_found ~uri:(CL.Request.uri req) ()
in
- let exn_handler exn =
- Log.info "Server" "EXN %s" (Printexc.to_string exn);
- return () in
let spec = {
- Http.Server.address = "0.0.0.0";
- auth = `None;
- callback;
- conn_closed = (fun _ -> ());
- port;
- exn_handler = exn_handler;
- timeout = Some 300.;
+ CL.Server.callback;
+ conn_closed = (fun _ _ -> ());
} in
- Log.info "Server" "Starting server";
Net.Manager.create (fun mgr interface id ->
let src = None, port in
Net.Manager.configure interface (`IPv4 ip) >>
- Http.Server.listen mgr (`TCPv4 (src, spec))
+ CL.listen mgr src spec
)
View
6,005 slides/setup.ml
6,005 additions, 0 deletions not shown
Please sign in to comment.
Something went wrong with that request. Please try again.