Permalink
Browse files

Add a basic server implementation

  • Loading branch information...
1 parent e357916 commit 4dc918668e37c84433b7baaf9c3e89a568e06ff9 @samoht samoht committed Mar 6, 2012
Showing with 81 additions and 1 deletion.
  1. +1 −1 Makefile
  2. +5 −0 ocp-get.ocp
  3. +75 −0 ocp_get_server.ml
View
@@ -1,6 +1,6 @@
OCPBUILD ?= ./_obuild/unixrun ./boot/ocp-build.boot
WGET ?= wget
-TARGET = ocp-get
+TARGET = ocp-get ocp-get-server
.PHONY: all
View
@@ -187,3 +187,8 @@ begin program "ocp-get"
files = [ "ocp.ml" ]
requires = [ "ocp-get-lib" ]
end
+
+begin program "ocp-get-server"
+ files = [ "ocp_get_server.ml" ]
+ requires = [ "ocp-get-lib" ]
+end
View
@@ -0,0 +1,75 @@
+open Sys
+open Unix
+open File
+open Server
+
+module Cudf = File.Cudf(File.Config)
+module Server = Server(File.Config)(Cudf)
+
+let usage =
+ Printf.sprintf "%s -p <port> [--debug]" Sys.argv.(0)
+
+let nice_exit () =
+ Printf.eprintf "%s\n%!" usage;
+ exit 2
+
+let version () =
+ Printf.printf "\
+%s version %s
+
+Copyright (C) 2012 OCamlPro - INRIA
+
+This is free software; see the source for copying conditions. There is NO
+warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.\n"
+ Sys.argv.(0) Config.version
+
+let debug = ref false
+
+let port = ref 9999
+let set_port p = port := p
+
+let args = Arg.align [
+ "-p" , Arg.Int set_port, " Set up the listening port (default is 9999)";
+ "--debug" , Arg.Set debug, " Print more debug messages";
+ "--version", Arg.Unit version, " Display version information";
+]
+
+let _ = Arg.parse args (fun s -> Printf.eprintf "%s: Unknown\n" s) usage
+
+let server fn =
+ let host = (gethostbyname(gethostname ())).h_addr_list.(0) in
+ let addr = ADDR_INET (host, !port) in
+ if !debug then
+ Printf.printf "Listening on port %d (%s) ...\n%!"
+ !port (string_of_inet_addr host);
+
+ establish_server fn addr
+
+let fn stdin stdout =
+ let print s = Printf.eprintf "%s\n%!" s in
+ let open Server in
+ match (input_value stdin : Server.api) with
+ | GetList t -> print "getList"
+ | GetOpam (t, name_version) -> print "GetOpam"
+ | GetArchive (t, opam) -> print "GetArchive"
+ | NewArchive (t, opam, archive) -> print "NewArchive"
+
+let _ =
+ handle_unix_error server fn
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

0 comments on commit 4dc9186

Please sign in to comment.