[opam server] start implementing the OPAM server repository pluggin.

It compiles, but untested. Morever 'opam-server-download' and 'opam-server-upload' are missing.

Most of the code is here, need to test it and finish to write more boring script stuff...

Makefile

@@ -2,9 +2,10 @@ BIN = /usr/local/bin
 OCPBUILD ?= ./_obuild/unixrun ./boot/ocp-build.boot
 OCAMLC=ocamlc
 SRC_EXT=src_ext
-TARGETS = opam \
+TARGETS = opam opam-server \
 	  opam-rsync-init opam-rsync-update opam-rsync-download opam-rsync-upload \
-	  opam-git-init opam-git-update opam-git-download opam-git-upload
+	  opam-git-init opam-git-update opam-git-download opam-git-upload \
+	  opam-server-init opam-server-update opam-server-download opam-server-upload
 
 .PHONY: all
 

opam.ocp

@@ -91,3 +91,39 @@ begin program "opam-git-upload"
   requires = [ "opam-lib" ]
 end
 
+
+(* SERVER *)
+begin library "opam-server-lib"
+  files = [
+    "src/repo/server/protocol.ml"
+    "src/repo/server/key.ml"
+    "src/repo/server/daemon.ml"
+    "src/repo/server/client.ml"
+  ]
+  requires = [ "opam-lib" ]
+end
+
+begin program "opam-server"
+  files = [ "src/repo/server/server.ml" ]
+  requires = [ "opam-server-lib" ]
+end
+
+begin program "opam-server-init"
+  files = [ "src/repo/server/init.ml" ]
+  requires = [ "opam-server-lib" ]
+end
+
+begin program "opam-server-update"
+  files = [ "src/repo/server/update.ml" ]
+  requires = [ "opam-server-lib" ]
+end
+
+begin program "opam-server-download"
+  files = [ "src/repo/server/download.ml" ]
+  requires = [ "opam-server-lib" ]
+end
+
+begin program "opam-server-upload"
+  files = [ "src/repo/server/upload.ml" ]
+  requires = [ "opam-server-lib" ]
+end

specs/roadmap.tex

@@ -1155,26 +1155,24 @@ \subsection{Binary Protocol}
 \hline
 0 & \verb+ClientVersion+ & \verb+version: string+ & Send the client version to the server \\
 \hline
-1 & \verb+InitList+ & -- & Ask for the list of all available OPAM files \\
+1 & \verb+GetList+ & -- & Ask for the list of all available OPAM files \\
 \hline
-2 & \verb+UpdateList+ & -- & Ask for the list of updated OPAM files \\
-\hline
-3 & \verb+GetOPAM+ & \verb+name   : string+ & Ask for the binary representation of \\
+2 & \verb+GetOPAM+ & \verb+name   : string+ & Ask for the binary representation of \\
   &                & \verb+version: string+ & a given OPAM file \\
 \hline
-4 & \verb+GetDescr+ & \verb+name   : string+ & Ask for the binary representation of \\
+3 & \verb+GetDescr+ & \verb+name   : string+ & Ask for the binary representation of \\
   &                 & \verb+version: string+ & a given description file \\
 \hline
-5 & \verb+GetArchive+ & \verb+name   : string+ & Ask for the binary representation of \\
+4 & \verb+GetArchive+ & \verb+name   : string+ & Ask for the binary representation of \\
   &                   & \verb+version: string+ & a given archive file \\
 \hline
-6 & \verb+NewPackage+ & \verb+name   : string+ & Create a new package on the server. \\
+5 & \verb+NewPackage+ & \verb+name   : string+ & Create a new package on the server. \\
   &                   & \verb+version: string+ & The client should provide the OPAM and \\
   &                   & \verb+opam   : string+ & descr files and the source archive. \\
   &                   & \verb+descr  : string+ & \\
   &                   & \verb+archive: string+ & \\
 \hline
-7 & \verb+NewVersion+ & \verb+name   : string+ & Upload a new version of an already existing \\
+6 & \verb+NewVersion+ & \verb+name   : string+ & Upload a new version of an already existing \\
   &                   & \verb+version: string+ & package on the server. The client \\
   &                   & \verb+opam   : string+ & should also provide a security key\\
   &                   & \verb+descr  : string+ & \\
@@ -1202,8 +1200,8 @@ \subsection{Binary Protocol}
 1 & \verb+PackageList+  & \verb+list   : (string*string) list+ & Return the list of available \\
   &                     &                                      & package names and versions \\
 \hline
-2 & \verb+OPAM+         & \verb+opam   : string+ & Return an OPAM file
-\\
+2 & \verb+OPAM+         & \verb+opam   : string+ & Return an OPAM file \\
+\hline
 3 & \verb+Descr+        & \verb+descr  : string+ & Return an OPAM file \\
 \hline
 4 & \verb+Archive+      & \verb+archive: string+ & Return an archive file \\

src/file.ml

@@ -687,6 +687,14 @@ module Make (F : F) = struct
     else
       F.empty
 
+  let filename = Filename.of_string "/dummy/"
+
+  let of_raw raw =
+    F.of_string filename raw
+
+  let to_raw t =
+    F.to_string filename t
+
 end
 
 open X
@@ -697,6 +705,8 @@ module type IO_FILE = sig
   val write: filename -> t -> unit
   val read : filename -> t
   val safe_read: filename -> t
+  val to_raw: t -> raw
+  val of_raw: raw -> t
 end
 
 module Config = struct

src/file.mli

@@ -20,6 +20,12 @@ module type IO_FILE = sig
   (** Read file contents. Return [empty] if the file does not exist. *)
   val safe_read: filename -> t
 
+  (** Return the file contents *)
+  val to_raw: t -> raw
+
+  (** Convert a raw string into a file *)
+  val of_raw: raw -> t
+
 end
 
 (** Configuration file: [$opam/config] *)

src/repo/server/client.ml

@@ -0,0 +1,91 @@
+(***********************************************************************)
+(*                                                                     *)
+(*    Copyright 2012 OCamlPro                                          *)
+(*    Copyright 2012 INRIA                                             *)
+(*                                                                     *)
+(*  All rights reserved.  This file is distributed under the terms of  *)
+(*  the GNU Public License version 3.0.                                *)
+(*                                                                     *)
+(*  TypeRex is distributed in the hope that it will be useful,         *)
+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of     *)
+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the      *)
+(*  GNU General Public License for more details.                       *)
+(*                                                                     *)
+(***********************************************************************)
+
+open Unix
+open Protocol
+open Types
+
+let rpc host =
+   let addr = ADDR_INET (host, default_port) in
+   process_client (open_connection addr)
+
+let protocol_error x msg = match x with
+  | Error r -> Globals.error_and_exit "Protocol error: %s (%s)" msg r
+  | _       -> Globals.error_and_exit "Protocol error: %s" msg
+
+let client_version host =
+  let req = ClientVersion Globals.opam_version in
+  match rpc host req with
+  | ServerVersion v ->
+      if v <> Globals.opam_version then
+        Globals.error_and_exit "API versions differ!"
+  | x -> protocol_error x "client_version"
+
+let get_list host =
+  client_version host;
+  match rpc host GetList with
+  | PackageList l ->
+      List.fold_left (fun accu (n,v) ->
+        NV.Set.add (NV.create (N.of_string n) (V.of_string v)) accu
+      ) NV.Set.empty l
+  | x -> protocol_error x "get_list"
+
+let get_opam host nv =
+  client_version host;
+  let req = GetOPAM (N.to_string (NV.name nv), V.to_string (NV.version nv)) in
+  match rpc host req with
+  | OPAM s -> File.OPAM.of_raw (Raw.of_string s)
+  | x -> protocol_error x "get_opam"
+
+let get_descr host nv =
+  client_version host;
+  let req = GetDescr (N.to_string (NV.name nv), V.to_string (NV.version nv)) in
+  match rpc host req with
+  | Descr s -> File.Descr.of_raw (Raw.of_string s)
+  | x -> protocol_error x "get_descr"
+
+let get_archive host nv =
+  client_version host;
+  let req = GetArchive (N.to_string (NV.name nv), V.to_string (NV.version nv)) in
+  match rpc host req with
+  | Archive s -> Raw.of_string s
+  | x -> protocol_error x "get_archive"
+
+let new_package host opam descr archive =
+  client_version host;
+  let n = File.OPAM.name opam in
+  let v = File.OPAM.version opam in
+  let req = NewPackage (N.to_string n, V.to_string v,
+                        Raw.to_string (File.OPAM.to_raw opam),
+                        Raw.to_string (File.Descr.to_raw descr),
+                        Raw.to_string archive) in
+  match rpc host req with
+  | Key s -> Key.of_string s
+  | x -> protocol_error x "new_package"
+
+let new_version host opam descr archive key =
+  client_version host;
+  let n = File.OPAM.name opam in
+  let v = File.OPAM.version opam in
+  let req = NewVersion (N.to_string n, V.to_string v,
+                        Raw.to_string (File.OPAM.to_raw opam),
+                        Raw.to_string (File.Descr.to_raw descr),
+                        Raw.to_string archive,
+                        Key.to_string key) in
+  match rpc host req with
+  | OK -> ()
+  | x  -> protocol_error x "new_package"
+
+

src/repo/server/client.mli

@@ -0,0 +1,36 @@
+(***********************************************************************)
+(*                                                                     *)
+(*    Copyright 2012 OCamlPro                                          *)
+(*    Copyright 2012 INRIA                                             *)
+(*                                                                     *)
+(*  All rights reserved.  This file is distributed under the terms of  *)
+(*  the GNU Public License version 3.0.                                *)
+(*                                                                     *)
+(*  TypeRex is distributed in the hope that it will be useful,         *)
+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of     *)
+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the      *)
+(*  GNU General Public License for more details.                       *)
+(*                                                                     *)
+(***********************************************************************)
+
+(** Client-side for OPAM server repositories *)
+
+open Types
+
+(** Get the list of available packages *)
+val get_list: Unix.inet_addr -> NV.Set.t
+
+(** Get an OPAM file *)
+val get_opam: Unix.inet_addr -> nv -> File.OPAM.t
+
+(** Get a desrciption file *)
+val get_descr: Unix.inet_addr -> nv -> File.Descr.t
+
+(** Get an archive file *)
+val get_archive: Unix.inet_addr -> nv -> raw
+
+(** Upload a new package *)
+val new_package: Unix.inet_addr -> File.OPAM.t -> File.Descr.t -> raw -> Key.t
+
+(** Upload a new package version *)
+val new_version: Unix.inet_addr -> File.OPAM.t -> File.Descr.t -> raw -> Key.t -> unit

src/repo/server/daemon.ml

@@ -0,0 +1,87 @@
+(***********************************************************************)
+(*                                                                     *)
+(*    Copyright 2012 OCamlPro                                          *)
+(*    Copyright 2012 INRIA                                             *)
+(*                                                                     *)
+(*  All rights reserved.  This file is distributed under the terms of  *)
+(*  the GNU Public License version 3.0.                                *)
+(*                                                                     *)
+(*  TypeRex is distributed in the hope that it will be useful,         *)
+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of     *)
+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the      *)
+(*  GNU General Public License for more details.                       *)
+(*                                                                     *)
+(***********************************************************************)
+
+open Protocol
+open Types
+
+let log fmt = Globals.log "DAEMON" fmt
+
+type t = {
+  (* ~/.opam-server/ *)
+  global: Path.G.t;
+
+  (* ~/.opam-server/opam/ files *)
+  available: NV.Set.t
+}
+
+let load_state () =
+  let global = Path.G.create (Dirname.of_string !Globals.root_path) in
+  let available = Path.G.available global in
+  { global; available }
+
+let get_file n v fn =
+  let t = load_state () in
+  let nv = NV.create (N.of_string n) (V.of_string v) in
+  Run.read (Filename.to_string (fn t.global nv))
+
+let write_files n v o d a =
+  let t = load_state () in
+  let nv = NV.create (N.of_string n) (V.of_string v) in
+  let write fn c =
+    Run.write (Filename.to_string (fn t.global nv)) c in
+  write Path.G.opam o;
+  write Path.G.descr d;
+  write Path.G.archive a
+
+let process_request id = function
+  | ClientVersion v ->
+      log "ClientVersion %s" v;
+      if v = Globals.opam_version then
+        ServerVersion v
+      else
+        Error "Wrong API version"
+  | GetList ->
+      log "GetList";
+      let t = load_state () in
+      let l = NV.Set.fold (fun nv l ->
+        (N.to_string (NV.name nv), V.to_string (NV.version nv)) :: l
+      ) t.available [] in
+      PackageList (List.rev l)
+  | GetOPAM (n,v) ->
+      log "GetOPAM (%s,%s)" n v;
+      OPAM (get_file n v Path.G.opam)
+  | GetDescr (n,v) ->
+      log "GetDescr (%s,%s)" n v;
+      Descr (get_file n v Path.G.descr)
+  | GetArchive (n,v) ->
+      log "GetArchive (%s,%s)" n v;
+      Archive (get_file n v Path.G.archive)
+  | NewPackage (n,v,o,d,a) ->
+      log "NewPackage (%s,%s,%s,%s,_)" n v o d;
+      write_files n v o d a;
+      let key = Key.create () in
+      Key.write (N.of_string n) key;
+      Key (Key.to_string key)
+  | NewVersion (n,v,o,d,a,k) ->
+      log "NewVersion (%s,%s,%s,%s,_,%s)" n v o d k;
+      let key = Key.read (N.of_string n) in
+      if key = (Digest.string k) then (
+        write_files n v o d a;
+        OK
+      ) else
+        Error "Wrong key"
+
+let process (stdin, stdout) fn =
+ process_server (stdin, stdout) fn

src/repo/server/daemon.mli

@@ -0,0 +1,28 @@
+(***********************************************************************)
+(*                                                                     *)
+(*    Copyright 2012 OCamlPro                                          *)
+(*    Copyright 2012 INRIA                                             *)
+(*                                                                     *)
+(*  All rights reserved.  This file is distributed under the terms of  *)
+(*  the GNU Public License version 3.0.                                *)
+(*                                                                     *)
+(*  TypeRex is distributed in the hope that it will be useful,         *)
+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of     *)
+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the      *)
+(*  GNU General Public License for more details.                       *)
+(*                                                                     *)
+(***********************************************************************)
+
+(** Server daemon *)
+
+open Protocol
+
+(** Main request processing function. [process_request id req]
+    processes the client request [req] and procuces a server
+    answer. Eventual log messages are tagged with [id]. *)
+val process_request: string -> client_to_server -> server_to_client
+
+(** Synchronous processing of client requests. [process channels fn]
+    will read incoming requests on channels, compute the server
+    response using [fn] and write the result to the channels. *)
+val process: (in_channel * out_channel) -> (client_to_server -> server_to_client) -> unit

src/repo/server/download.ml

@@ -0,0 +1,4 @@
+(* Download script for OPAM server repositories *)
+
+let _ =
+  failwith "TODO"