Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Fix ocp.ml into chunks

This is a necessary step to add the server implantation
  • Loading branch information...
commit e357916da6690a8bd58d1e666a670478baa2bca1 1 parent dc8dc58
@samoht samoht authored
View
1  config.ml
@@ -0,0 +1 @@
+let version = "0.1+dev"
View
373 file.ml
@@ -0,0 +1,373 @@
+open Namespace
+open Path
+
+let filename_of_string s =
+ List.fold_left
+ (fun t s -> Path.concat t (B s))
+ Path.root
+ (BatString.nsplit (BatString.strip ~chars:"/" s) "/")
+
+module File =
+struct
+ open Namespace
+
+ module type PRINTF =
+ sig
+ type t
+ type out_channel
+
+ val init : unit -> t
+ val read_line : t -> string * t
+ val printf : t -> ('a, out_channel, t) format -> 'a
+ end
+
+ module P : PRINTF =
+ struct
+ type t = unit
+ include Pervasives
+
+ let init x = x
+ let read_line () =
+ read_line (), ()
+ let printf () = Printf.printf
+ end
+
+ module type IO_FILE =
+ sig
+ type t
+
+ val find : Path.t -> Path.filename -> t
+ val add : Path.t -> Path.filename -> t -> Path.t
+ end
+
+ module type CONFIG =
+ sig
+ include IO_FILE
+
+ val empty_package_manager : internal_version
+ val empty_ocaml : internal_version
+ val version_of_string : string -> internal_version
+
+ (** destruct *)
+ val package_manager : t -> internal_version
+ val sources : t -> Path.url option
+ val ocaml_version : t -> internal_version
+
+
+ (** construct *)
+ val config : internal_version (* opam *) -> Path.url option -> internal_version (* ocaml *) -> t
+ end
+
+ let filter motif =
+ BatList.filter_map
+ (fun s ->
+ try Some (BatPair.map BatString.trim (BatString.split (BatString.trim s) motif)) with Not_found -> None)
+
+ let parse motif s = filter motif (BatString.nsplit s "\n")
+
+ let parse_colon = parse ":"
+ let parse_space = parse " "
+
+ module Config : CONFIG =
+ struct
+ type t = { version : internal_version ; sources : Path.url option ; ocaml_version : internal_version }
+
+ let empty_package_manager = Version "1"
+ let empty_ocaml = Version Sys.ocaml_version
+ let version_of_string s = Version s
+
+ let package_manager t = t.version
+ let sources t = t.sources
+ let ocaml_version t = t.ocaml_version
+ let config version sources ocaml_version = { version ; sources ; ocaml_version }
+
+ let ocamlpro_http = "opam.ocamlpro.com"
+ let ocamlpro_port = 9999
+ let empty1 = { version = Version "" ; sources = Some (Path.url ocamlpro_http (Some ocamlpro_port)) ; ocaml_version = Version Sys.ocaml_version }
+ let empty2 = { version = Version "" ; sources = None ; ocaml_version = Version Sys.ocaml_version }
+
+ let find t f =
+ match Path.find t f with
+ | Path.File (Binary s) ->
+ (match parse_colon s with
+ | ("version", version)
+ :: ("sources", sources)
+ :: ("ocaml-version", ocaml_version)
+
+ :: _ -> { version = Version version
+ ; sources =
+ (try Some (let hostname, port = BatString.split sources ":" in
+ Path.url hostname (try Some (int_of_string port) with _ -> None)) with _ -> None)
+ ; ocaml_version = Version ocaml_version }
+ | _ -> empty1)
+ | _ -> empty2
+
+ let to_string t =
+ Printf.sprintf "
+version: %s
+sources: %s"
+ (match t.version with Version s -> s)
+ (match t.sources with None -> Printf.sprintf "%s:%d" ocamlpro_http ocamlpro_port | Some sources -> Path.string_of_url sources)
+
+ let add t f v = Path.add t f (Path.File (Binary (to_string v)))
+ end
+
+ module type CUDF =
+ sig
+ include IO_FILE
+
+ (** destruct *)
+ val package : t -> Cudf.package
+ val description : Cudf.package -> string
+
+ (** construct *)
+ val new_package : name_version -> string (* description *) -> Cudf.package
+ val cudf : internal_version (* package manager *) -> Cudf.package -> t
+ end
+
+ module Cudf (F_config : CONFIG) : CUDF =
+ struct
+ type package =
+ { preamble : Cudf.preamble option
+ ; pkg : Cudf.package list
+ ; request : Cudf.request option }
+
+ type t =
+ { opam_version : internal_version
+ ; package : package }
+
+ let find_field key = function
+ | [x] -> (try Some (List.assoc key x.Cudf.pkg_extra) with Not_found -> None)
+ | _ -> None
+
+ let package t =
+ match t.package.pkg with
+ | [ x ] -> x
+ | _ -> Cudf.default_package
+
+ let name p = match p.pkg with [x] -> x.Cudf.package | _ -> ""
+ let version p = match p.pkg with [x] -> x.Cudf.version | _ -> min_int
+
+ let s_description = "description"
+ let description p =
+ match find_field s_description [ p ] with
+ | Some (`String s) -> s
+ | _ -> ""
+
+ let new_package (Name name, version) description =
+ { Cudf.default_package with
+ Cudf.package = name ;
+ Cudf.version = version.cudf ;
+ Cudf.pkg_extra = [ s_description, `String description ] }
+
+ let cudf opam_version pkg = { opam_version ; package = { preamble = None ; pkg = [ pkg ] ; request = None } }
+
+ let empty =
+ { opam_version = F_config.empty_package_manager
+ ; package = { preamble = None ; pkg = [] ; request = None } }
+
+ let find t f =
+ match Path.find t f with
+ | Path.File (Binary s) ->
+ (match
+ try
+ Some (Cudf_parser.parse (Cudf_parser.from_IO_in_channel (IO.input_string s)))
+ with _ -> None
+ with
+ | None -> empty
+ | Some (preamble, pkg, request) ->
+ { opam_version =
+ (match find_field "opam_version" pkg with
+ | Some (`String v) -> F_config.version_of_string v
+ | _ -> empty.opam_version)
+ ; package = { preamble ; pkg ; request } })
+ | _ -> empty
+
+ let to_string t =
+ let oc = IO.output_string () in
+ let () =
+ begin
+ (match t.package.preamble with
+ | Some preamble -> Cudf_printer.pp_io_preamble oc preamble
+ | None -> ());
+ List.iter (Cudf_printer.pp_io_package oc) t.package.pkg;
+ (match t.package.request with
+ | Some request -> Cudf_printer.pp_io_request oc request
+ | None -> ());
+ end in
+ IO.close_out oc
+
+ let add t f v = Path.add t f (Path.File (Binary (to_string v)))
+ end
+
+ module type INSTALLED =
+ sig
+ include IO_FILE with type t = name_version list
+ end
+
+ module Installed : INSTALLED =
+ struct
+ type t = name_version list
+ let empty = []
+
+ let find t f =
+ match Path.find t f with
+ | Path.File (Binary s) ->
+ BatList.map (fun (name, version) -> Name name, version_of_string name version) (parse_space s)
+ | _ -> empty
+
+ let to_string =
+ BatIO.to_string (BatList.print (fun oc (name, version) -> BatString.print oc (Printf.sprintf "%s %s"
+ (Namespace.string_user_of_name name)
+ (Namespace.string_user_of_version version))))
+ let add t f v = Path.add t f (Path.File (Binary (to_string v)))
+ end
+
+ type basename_last =
+ | Suffix of string
+ (* Designates a file which have [string] as suffix, ie. cmo, cma, cmi, cmx...
+ More generally, a file which name is "file.ssss" will have "ssss" as suffix. *)
+ (** By default, every matching value will be considered (ie. the regexp equivalent to ".*" ). *)
+ | Exact of string
+
+ type prefix =
+ | Absolute (** consider that the path begins at "/" *)
+ | Relative
+
+ type path = prefix * basename list * basename_last
+
+ type misc = { p_from : path ; p_to : path }
+
+ let string_of_path (pref, l, b) =
+ Printf.sprintf "(%s, %s, %s)"
+ (match pref with Absolute -> "Absolute" | Relative -> "Relative")
+ (BatIO.to_string (BatList.print (fun oc (B b) -> BatString.print oc b)) l)
+ (match b with Suffix s -> Printf.sprintf "Suffix %s" s | Exact s -> Printf.sprintf "Exact %s" s)
+
+ module type TO_INSTALL =
+ sig
+ include IO_FILE
+
+ (** destruct *)
+ val lib : t -> path list
+ val bin : t -> path
+ val misc : t -> misc list
+
+ val path_from : misc -> path
+ val path_to : misc -> path
+ val string_of_misc : misc -> string
+
+ val filename_of_path_relative : Path.t -> Path.filename (* prefix *) -> path -> Path.filename list
+ val filename_of_path_absolute : Path.t -> path -> Path.filename list
+
+
+ (** construct *)
+ end
+
+ module To_install : TO_INSTALL =
+ struct
+ type t =
+ { lib : path list
+ ; bin : path
+ ; misc : misc list }
+
+ let lib t = t.lib
+ let bin t = t.bin
+ let misc t = t.misc
+ let path_from m = m.p_from
+ let path_to m = m.p_to
+
+ let string_of_misc m =
+ Printf.sprintf "from %s to %s" (string_of_path m.p_from) (string_of_path m.p_to)
+
+ let filename_of_path t f l_b suff =
+ let f = List.fold_left Path.concat f l_b in
+ BatList.map (Path.concat f)
+ (match suff with
+ | Exact name -> [ B name ]
+ | Suffix suff ->
+ BatList.filter
+ (fun (B name) ->
+ (try Some (snd (BatString.split name ".")) with _ -> None) = Some suff)
+ (match Path.find t f with Path.Directory l -> l | _ -> []))
+
+ let filename_of_path_relative t f = function
+ | Relative, l_b, suff -> filename_of_path t f l_b suff
+ | Absolute, _, _ -> assert false
+
+ let filename_of_path_absolute t = function
+ | Absolute, l_b, suff -> filename_of_path t Path.root l_b suff
+ | _ -> assert false
+
+ let empty = { lib = []
+ ; bin = Relative, [], Suffix ""
+ ; misc = [] }
+
+ let b_of_string abs s =
+ let l = BatString.nsplit (BatString.strip ~chars:"/" s) "/" in
+ match List.rev l with
+ | x :: xs ->
+ abs,
+ BatList.map (fun s -> B s) (List.rev xs),
+ (match try Some (BatString.split x "*.") with _ -> None with
+ | Some ("", suff) -> Suffix suff
+ | _ -> Exact x)
+ | [] -> abs, [], Exact ""
+
+ let relative_path_of_string = b_of_string Relative
+
+ let find t f =
+ match Path.find t f with
+ | Path.File (Binary s) ->
+
+ let l_lib_bin, l_misc =
+ let l, f_while =
+ BatString.nsplit s "\n",
+ fun s ->
+ match try Some (BatString.split "misc" (BatString.trim s)) with _ -> None with
+ | Some ("", _) -> true
+ | _ -> false in
+ BatList.take_while f_while l, BatList.drop_while f_while l in
+
+ (match filter ":" l_lib_bin with
+ | ("lib", lib)
+ :: ("bin", bin) :: _ ->
+ { lib = BatList.map relative_path_of_string (BatString.nsplit lib ",")
+ ; bin = relative_path_of_string bin
+ ; misc =
+ BatList.map
+ (fun (s_path, s_fname) ->
+ { p_from = relative_path_of_string s_path ; p_to = b_of_string Absolute s_fname })
+ (filter " " l_misc) }
+ | _ -> empty)
+
+ | _ -> empty
+
+
+ let to_string t =
+
+ let path_print oc (pref, l_base, base) =
+ begin
+ BatString.print oc (match pref with Absolute -> "/" | Relative -> "");
+ BatList.print ~first:"" ~last:"/" ~sep:"/" (fun oc (B base) -> BatString.print oc base) oc l_base;
+ BatString.print oc (match base with Suffix s -> Printf.sprintf "*.%s" s | Exact s -> s);
+ end in
+
+ Printf.sprintf "
+lib: %s
+bin: %s
+misc:
+%s"
+ (BatIO.to_string (BatList.print ~first:"" ~last:"" ~sep:", " path_print) t.lib)
+ (BatIO.to_string path_print t.bin)
+ (BatIO.to_string (BatList.print ~first:"" ~last:"" ~sep:"\n"
+ (fun oc misc ->
+ begin
+ path_print oc (misc.p_from);
+ BatString.print oc " ";
+ path_print oc (misc.p_to);
+ end)) t.misc)
+
+ let add t f v = Path.add t f (Path.File (Binary (to_string v)))
+ end
+end
View
43 namespace.ml
@@ -0,0 +1,43 @@
+module Namespace =
+struct
+ open Printf
+
+ type name = Name of Cudf_types.pkgname
+ let name_compare = compare
+
+ type version = { deb : Debian.Format822.version ; cudf : Cudf_types.version }
+ let version_compare v1 v2 = compare v1.cudf v2.cudf
+
+ let string_of_nv (Name n) version = sprintf "%s-%s" n version.deb
+ let string_of_name (Name n) = n
+ let string_user_of_name (Name n) = n
+ let string_user_of_version version = version.deb
+
+ let table = ref (Debian.Debcudf.init_tables [])
+
+ let version_of_string n version = { deb = version ; cudf = Debian.Debcudf.get_cudf_version !table (n, version) }
+
+ let nv_of_string s =
+ let n, version = BatString.split s "-" in
+ Name n, version_of_string n version
+end
+
+type name_version = Namespace.name * Namespace.version
+
+module N_map = BatMap.Make (struct open Namespace type t = name let compare = name_compare end)
+module V_set = BatSet.Make (struct open Namespace type t = version let compare = version_compare end)
+
+module NV_orderedtype =
+struct
+ open Namespace
+ type t = name_version
+ let compare (n1, v1) (n2, v2) =
+ let c = name_compare n1 n2 in
+ if c = 0 then
+ version_compare v1 v2
+ else
+ c
+end
+
+module NV_map = BatMap.Make (NV_orderedtype)
+module NV_set = BatSet.Make (NV_orderedtype)
View
20 ocp-get.ocp
@@ -1,6 +1,6 @@
(* typerex support *)
-(* ocamlc = ["ocp-ocamlc.opt"]
- ocamlopt = ["ocp-ocamlopt.opt"] *)
+ocamlc = ["ocp-ocamlc.opt"]
+ocamlopt = ["ocp-ocamlopt.opt"]
begin library "extlib"
sort = true
@@ -166,8 +166,15 @@ begin library "dose"
end
-begin program "ocp-get"
- files = [ "ocp.ml" ]
+begin library "ocp-get-lib"
+ files = [
+ "config.ml"
+ "namespace.ml"
+ "path.ml"
+ "file.ml"
+ "server.ml"
+ ]
+
requires = [
"cudf"
"dose"
@@ -175,3 +182,8 @@ begin program "ocp-get"
"unix"
]
end
+
+begin program "ocp-get"
+ files = [ "ocp.ml" ]
+ requires = [ "ocp-get-lib" ]
+end
View
808 ocp.ml
@@ -1,697 +1,8 @@
-module Namespace =
-struct
- open Printf
-
- type name = Name of Cudf_types.pkgname
- let name_compare = compare
-
- type version = { deb : Debian.Format822.version ; cudf : Cudf_types.version }
- let version_compare v1 v2 = compare v1.cudf v2.cudf
-
- let string_of_nv (Name n) version = sprintf "%s-%s" n version.deb
- let string_of_name (Name n) = n
- let string_user_of_name (Name n) = n
- let string_user_of_version version = version.deb
-
- let table = ref (Debian.Debcudf.init_tables [])
-
- let version_of_string n version = { deb = version ; cudf = Debian.Debcudf.get_cudf_version !table (n, version) }
-
- let nv_of_string s =
- let n, version = BatString.split s "-" in
- Name n, version_of_string n version
-end
-
-type name_version = Namespace.name * Namespace.version
-
-module N_map = BatMap.Make (struct open Namespace type t = name let compare = name_compare end)
-module V_set = BatSet.Make (struct open Namespace type t = version let compare = version_compare end)
-
-module NV_orderedtype =
-struct
- open Namespace
- type t = name_version
- let compare (n1, v1) (n2, v2) =
- let c = name_compare n1 n2 in
- if c = 0 then
- version_compare v1 v2
- else
- c
-end
-
-module NV_map = BatMap.Make (NV_orderedtype)
-module NV_set = BatSet.Make (NV_orderedtype)
-
-type 'a ocaml_options =
- | I of 'a
-
-type binary_data =
- | Binary of string (* contents *)
- | Filename of string (* pointer to the contents *)
-
-type 'a archive =
- | Tar_gz of 'a
- | Empty
-
-type basename = B of string
-
-type internal_version = Version of string
-(** Type used to represent an internal form of version, which is in particular not related to the version of a particular package *)
-
-module type PATH =
-sig
-
- type t
- type filename
- type url
-
- type 'a contents =
- | Directory of basename list
- | File of 'a
- | Not_exists
-
- type 'a contents_rec =
- | R_directory of (basename * 'a contents_rec) list
- | R_file of 'a
- | R_filename of filename list
-
- val init : url option (* [None] : local *) -> string (* $HOME_OPAM *) -> internal_version (* OVERSION *) -> t
- (* $HOME_OPAM_OVERSION = $HOME_OPAM/OVERSION *)
-
- (** definitions of some shortcuts *)
- val root : filename (* / *)
- (** the root of every path *)
- val package : t -> filename (* $PWD *)
- (** path in the packager filesystem, contains the collection of libraries and programs *)
- val lib : t -> Namespace.name -> filename (* $HOME_OPAM_OVERSION/lib/NAME *)
- (** installed libraries for the package (at most one version installed) *)
- val bin : t -> filename (* $HOME_OPAM_OVERSION/bin *)
- (** contain installed binaries *)
- val config : t -> filename (* $HOME_OPAM/config *)
- (** main configuration file *)
- val installed : t -> filename (* $HOME_OPAM_OVERSION/installed *)
- (** list of installed packages with their version *)
- val index_opam : t -> name_version option -> filename (* $HOME_OPAM/index/NAME-VERSION.opam *)
- (** OPAM files considered for an arbitrary version and package *)
- val index_opam_list : t -> name_version list (* [ $HOME_OPAM/index/NAME-VERSION.opam ] -> [ NAME, VERSION ] *)
- (** list of OPAM files *)
- val archives_targz : t -> name_version option -> filename (* $HOME_OPAM/archives/NAME-VERSION.tar.gz *)
- (** source archives for all versions of all packages *)
- val build : t -> name_version option -> filename (* $HOME_OPAM_OVERSION/build/NAME-VERSION *)
- (** tempory folders used to decompress the corresponding archives *)
- val to_install : t -> name_version -> filename (* $HOME_OPAM_OVERSION/build/NAME-VERSION/NAME.install *)
- (** compiled files in the extracted archive to install *)
-
- (** **)
-
- val find : t -> filename -> binary_data contents
- (** Retrieves the contents from the hard disk. *)
-
- val remove : t -> filename -> t
- (** Removes everything in [filename] if existed. *)
-
- val add : t -> filename -> binary_data contents -> t
- (** Removes everything in [filename] if existed, then write [contents] instead. *)
-
- val add_rec : t -> filename -> binary_data contents_rec -> t
- (** Removes everything in [filename] if existed, then write [contents_rec] inside [filename]. *)
-
- val extract_targz : t -> binary_data archive -> binary_data contents_rec
- (** Returns the same meaning as [archive] but in extracted form. *)
-
- val exec_buildsh : t -> name_version -> t
- (* $HOME_OPAM/build/NAME-VERSION/build.sh *)
- (** Executes this particularly named script. *)
-
- val dirname : filename -> filename
- (** see [Filename.dirname] *)
-
- val basename : filename -> basename
- (** see [Filename.basename] *)
-
- val chop_extension : basename -> string
- (** see [Filename.chop_extension] *)
-
- val concat : filename -> basename -> filename
- (** see [Filename.concat] *)
-
- val file_exists : filename -> bool
- (** see [Sys.file_exists] *)
-
- val ocaml_options_of_library : t -> Namespace.name -> string ocaml_options
- (* $HOME_OPAM/lib/NAME *)
- (** Returns the exact path to give to the OCaml compiler (ie. -I ...) *)
-
- val url : string (* hostname *) -> int option (* port *) -> url
- val change_url : t -> url -> t
- val string_of_url : url -> string
- (** in the format "HOSTNAME:PORT" *)
- val compare_computer : t -> t -> int
-end
-
-module Path : PATH =
-struct
- open Printf
-
- type url = U of string
-
- type filename =
- | Normalized of string
- | Raw of string
-
- type t = { computer : url option (* [None] : local *)
- ; home : string
- ; home_ocamlversion : string }
-
- type 'a contents =
- | Directory of basename list
- | File of 'a
- | Not_exists
-
- type 'a contents_rec =
- | R_directory of (basename * 'a contents_rec) list
- | R_file of 'a
- | R_filename of filename list
-
- let s_of_filename = function
- | Normalized s -> s
- | Raw s -> s
-
- let filename_map f = function
- | Normalized s -> Normalized (f s)
- | Raw s -> Raw (f s)
-
- let normalize s =
- let getchdir s =
- let p = Unix.getcwd () in
- let () = Unix.chdir s in
- p in
-
- Normalized (getchdir (getchdir s))
-
- let home = Unix.getenv "HOME"
- let (//) = sprintf "%s/%s"
- let concat f (B s) = filename_map (fun filename -> filename // s) f
- let (///) = concat
- let init o s (Version ocamlv) =
- let home = home // s in
- { computer = o ; home ; home_ocamlversion = home // ocamlv }
-
- let root = Raw "/"
- let package _ = normalize "."
- let lib t (Namespace.Name n) = Raw (t.home_ocamlversion // "lib" // n)
- let bin t = Raw (t.home_ocamlversion // "bin")
-
- let mk_name_version t_home d ext n v = Raw (t_home // d // sprintf "%s%s" (Namespace.string_of_nv n v) ext)
-
- let mk_name_version_o t_home name ext =
- function
- | None -> Raw (t_home // name)
- | Some (n, v) -> mk_name_version t_home name ext n v
-
- let index_opam t = mk_name_version_o t.home "index" ".opam"
- let archives_targz t = mk_name_version_o t.home "archives" ".tar.gz"
-
- let build t = mk_name_version_o t.home_ocamlversion "build" ""
- let installed t = Raw (t.home_ocamlversion // "installed")
- let config t = Raw (t.home // "config")
-
- let to_install t (n, v) = build t (Some (n, v)) /// B (Namespace.string_of_name n ^ ".install")
-
- let url x o = U (sprintf "%s%s" x (match o with None -> "" | Some i -> sprintf ":%d" i))
-
- let change_url t u = { t with computer = Some u }
-
- let contents f_dir f_fic f_not_exists t f =
- match t.computer with
- | None ->
- let fic = s_of_filename f in
- if Sys.file_exists fic then
- (if Sys.is_directory fic then f_dir else f_fic) fic
- else
- f_not_exists
- | Some _ -> failwith "to complete !"
-
-
- let find =
- contents
- (fun fic -> Directory (BatList.of_enum (BatEnum.map (fun s -> B s) (BatSys.files_of fic))))
- (fun fic -> File ((*Binary (BatFile.with_file_in fic BatIO.read_all)*)Filename fic))
- Not_exists
-
- let chop_extension (B s) = Filename.chop_extension s
- let file_exists f = Sys.file_exists (s_of_filename f)
-
- let index_opam_list t =
- BatList.map (fun fic -> Namespace.nv_of_string (chop_extension fic))
- (match find t (index_opam t None) with
- | Directory l -> l
- | _ -> [])
-
- let remove t f =
- let rec aux fic =
- match (Unix.lstat fic).Unix.st_kind with
- | Unix.S_DIR ->
- let () = BatEnum.iter (fun f -> aux (fic // f)) (BatSys.files_of fic) in
- Unix.rmdir fic
- | Unix.S_REG -> Unix.unlink fic
- | _ -> failwith "to complete !" in
- let () = aux (s_of_filename f) in
- t
-
- let add t f =
- function
- | Directory d -> failwith "to complete !"
- | File (Binary cts) ->
- let () = contents (fun _ -> failwith "to complete !") Unix.unlink () t f in
- let fic = s_of_filename f in
- let () = BatFile.with_file_out fic (fun oc -> BatString.print oc cts) in
- t
- | File (Filename fic) -> failwith "to complete ! copy the given filename"
- | Not_exists -> failwith "to complete !"
-
- let compare_computer t1 t2 = compare t1.computer t2.computer
-
- let exec_buildsh t n_v =
- let _ = Sys.chdir (s_of_filename (build t (Some n_v))) in
- let _ = Sys.command "build.sh" in
- t
- let basename s = B (Filename.basename (s_of_filename s))
-
- let extract_targz t = function
- | Tar_gz (Binary _) -> failwith "to complete ! check if the \"dose\" project has been configured with the correct option to extract the gzip or bz2, then use similars functions to extract" (*IO.read_all (Common.Input.open_file fic)*)
- | Tar_gz (Filename fic) -> R_filename [Raw fic]
- | Empty -> R_directory []
-
- let lstat s = Unix.lstat (s_of_filename s)
- let files_of f = BatSys.files_of (s_of_filename f)
-
- let dirname = filename_map Filename.dirname
-
- let add_rec t f =
- let () = (* check that [f] is not a file *)
- contents
- (fun _ -> ())
- (fun _ -> failwith "to complete !")
- () t f in
-
- let rec aux t f (* <- filename dir *) name (* name of the value that will be destructed*) = function
- | R_directory l ->
- List.fold_left
- (let f = f /// name in
- fun t (b, cts) -> aux t f b cts) t l
- | R_file cts -> add t (f /// name) (File cts)
- | R_filename l ->
- List.fold_left
- (fun t fic ->
- aux
- t
- f
- (basename fic)
- (match (lstat fic).Unix.st_kind with
- | Unix.S_DIR -> R_directory (BatList.map (fun f ->
- let f = B f in
- f, R_filename [fic /// f]) (files_of fic))
- | Unix.S_REG -> R_file (Filename (s_of_filename fic))
- | _ -> failwith "to complete !")) t l in
- aux t (dirname f) (basename f)
-
- let ocaml_options_of_library t name =
- I (Printf.sprintf "%s" (s_of_filename (lib t name)))
-
- let string_of_url (U s) = s
-end
-
-let filename_of_string s =
- List.fold_left
- (fun t s -> Path.concat t (B s))
- Path.root
- (BatString.nsplit (BatString.strip ~chars:"/" s) "/")
-
-module File =
-struct
- open Namespace
-
- module type PRINTF =
- sig
- type t
- type out_channel
-
- val init : unit -> t
- val read_line : t -> string * t
- val printf : t -> ('a, out_channel, t) format -> 'a
- end
-
- module P : PRINTF =
- struct
- type t = unit
- include Pervasives
-
- let init x = x
- let read_line () =
- read_line (), ()
- let printf () = Printf.printf
- end
-
- module type IO_FILE =
- sig
- type t
-
- val find : Path.t -> Path.filename -> t
- val add : Path.t -> Path.filename -> t -> Path.t
- end
-
- module type CONFIG =
- sig
- include IO_FILE
-
- val empty_package_manager : internal_version
- val empty_ocaml : internal_version
- val version_of_string : string -> internal_version
-
- (** destruct *)
- val package_manager : t -> internal_version
- val sources : t -> Path.url option
- val ocaml_version : t -> internal_version
-
-
- (** construct *)
- val config : internal_version (* opam *) -> Path.url option -> internal_version (* ocaml *) -> t
- end
-
- let filter motif =
- BatList.filter_map
- (fun s ->
- try Some (BatPair.map BatString.trim (BatString.split (BatString.trim s) motif)) with Not_found -> None)
-
- let parse motif s = filter motif (BatString.nsplit s "\n")
-
- let parse_colon = parse ":"
- let parse_space = parse " "
-
- module Config : CONFIG =
- struct
- type t = { version : internal_version ; sources : Path.url option ; ocaml_version : internal_version }
-
- let empty_package_manager = Version "1"
- let empty_ocaml = Version Sys.ocaml_version
- let version_of_string s = Version s
-
- let package_manager t = t.version
- let sources t = t.sources
- let ocaml_version t = t.ocaml_version
- let config version sources ocaml_version = { version ; sources ; ocaml_version }
-
- let ocamlpro_http = "opam.ocamlpro.com"
- let ocamlpro_port = 9999
- let empty1 = { version = Version "" ; sources = Some (Path.url ocamlpro_http (Some ocamlpro_port)) ; ocaml_version = Version Sys.ocaml_version }
- let empty2 = { version = Version "" ; sources = None ; ocaml_version = Version Sys.ocaml_version }
-
- let find t f =
- match Path.find t f with
- | Path.File (Binary s) ->
- (match parse_colon s with
- | ("version", version)
- :: ("sources", sources)
- :: ("ocaml-version", ocaml_version)
-
- :: _ -> { version = Version version
- ; sources =
- (try Some (let hostname, port = BatString.split sources ":" in
- Path.url hostname (try Some (int_of_string port) with _ -> None)) with _ -> None)
- ; ocaml_version = Version ocaml_version }
- | _ -> empty1)
- | _ -> empty2
-
- let to_string t =
- Printf.sprintf "
-version: %s
-sources: %s"
- (match t.version with Version s -> s)
- (match t.sources with None -> Printf.sprintf "%s:%d" ocamlpro_http ocamlpro_port | Some sources -> Path.string_of_url sources)
-
- let add t f v = Path.add t f (Path.File (Binary (to_string v)))
- end
-
- module type CUDF =
- sig
- include IO_FILE
-
- (** destruct *)
- val package : t -> Cudf.package
- val description : Cudf.package -> string
-
- (** construct *)
- val new_package : name_version -> string (* description *) -> Cudf.package
- val cudf : internal_version (* package manager *) -> Cudf.package -> t
- end
-
- module Cudf (F_config : CONFIG) : CUDF =
- struct
- type package =
- { preamble : Cudf.preamble option
- ; pkg : Cudf.package list
- ; request : Cudf.request option }
-
- type t =
- { opam_version : internal_version
- ; package : package }
-
- let find_field key = function
- | [x] -> (try Some (List.assoc key x.Cudf.pkg_extra) with Not_found -> None)
- | _ -> None
-
- let package t =
- match t.package.pkg with
- | [ x ] -> x
- | _ -> Cudf.default_package
-
- let name p = match p.pkg with [x] -> x.Cudf.package | _ -> ""
- let version p = match p.pkg with [x] -> x.Cudf.version | _ -> min_int
-
- let s_description = "description"
- let description p =
- match find_field s_description [ p ] with
- | Some (`String s) -> s
- | _ -> ""
-
- let new_package (Name name, version) description =
- { Cudf.default_package with
- Cudf.package = name ;
- Cudf.version = version.cudf ;
- Cudf.pkg_extra = [ s_description, `String description ] }
-
- let cudf opam_version pkg = { opam_version ; package = { preamble = None ; pkg = [ pkg ] ; request = None } }
-
- let empty =
- { opam_version = F_config.empty_package_manager
- ; package = { preamble = None ; pkg = [] ; request = None } }
-
- let find t f =
- match Path.find t f with
- | Path.File (Binary s) ->
- (match
- try
- Some (Cudf_parser.parse (Cudf_parser.from_IO_in_channel (IO.input_string s)))
- with _ -> None
- with
- | None -> empty
- | Some (preamble, pkg, request) ->
- { opam_version =
- (match find_field "opam_version" pkg with
- | Some (`String v) -> F_config.version_of_string v
- | _ -> empty.opam_version)
- ; package = { preamble ; pkg ; request } })
- | _ -> empty
-
- let to_string t =
- let oc = IO.output_string () in
- let () =
- begin
- (match t.package.preamble with
- | Some preamble -> Cudf_printer.pp_io_preamble oc preamble
- | None -> ());
- List.iter (Cudf_printer.pp_io_package oc) t.package.pkg;
- (match t.package.request with
- | Some request -> Cudf_printer.pp_io_request oc request
- | None -> ());
- end in
- IO.close_out oc
-
- let add t f v = Path.add t f (Path.File (Binary (to_string v)))
- end
-
- module type INSTALLED =
- sig
- include IO_FILE with type t = name_version list
- end
-
- module Installed : INSTALLED =
- struct
- type t = name_version list
- let empty = []
-
- let find t f =
- match Path.find t f with
- | Path.File (Binary s) ->
- BatList.map (fun (name, version) -> Name name, version_of_string name version) (parse_space s)
- | _ -> empty
-
- let to_string =
- BatIO.to_string (BatList.print (fun oc (name, version) -> BatString.print oc (Printf.sprintf "%s %s"
- (Namespace.string_user_of_name name)
- (Namespace.string_user_of_version version))))
- let add t f v = Path.add t f (Path.File (Binary (to_string v)))
- end
-
- type basename_last =
- | Suffix of string
- (* Designates a file which have [string] as suffix, ie. cmo, cma, cmi, cmx...
- More generally, a file which name is "file.ssss" will have "ssss" as suffix. *)
- (** By default, every matching value will be considered (ie. the regexp equivalent to ".*" ). *)
- | Exact of string
-
- type prefix =
- | Absolute (** consider that the path begins at "/" *)
- | Relative
-
- type path = prefix * basename list * basename_last
-
- type misc = { p_from : path ; p_to : path }
-
- let string_of_path (pref, l, b) =
- Printf.sprintf "(%s, %s, %s)"
- (match pref with Absolute -> "Absolute" | Relative -> "Relative")
- (BatIO.to_string (BatList.print (fun oc (B b) -> BatString.print oc b)) l)
- (match b with Suffix s -> Printf.sprintf "Suffix %s" s | Exact s -> Printf.sprintf "Exact %s" s)
-
- module type TO_INSTALL =
- sig
- include IO_FILE
-
- (** destruct *)
- val lib : t -> path list
- val bin : t -> path
- val misc : t -> misc list
-
- val path_from : misc -> path
- val path_to : misc -> path
- val string_of_misc : misc -> string
-
- val filename_of_path_relative : Path.t -> Path.filename (* prefix *) -> path -> Path.filename list
- val filename_of_path_absolute : Path.t -> path -> Path.filename list
-
-
- (** construct *)
- end
+open Namespace
+open Path
+open File
- module To_install : TO_INSTALL =
- struct
- type t =
- { lib : path list
- ; bin : path
- ; misc : misc list }
-
- let lib t = t.lib
- let bin t = t.bin
- let misc t = t.misc
- let path_from m = m.p_from
- let path_to m = m.p_to
-
- let string_of_misc m =
- Printf.sprintf "from %s to %s" (string_of_path m.p_from) (string_of_path m.p_to)
-
- let filename_of_path t f l_b suff =
- let f = List.fold_left Path.concat f l_b in
- BatList.map (Path.concat f)
- (match suff with
- | Exact name -> [ B name ]
- | Suffix suff ->
- BatList.filter
- (fun (B name) ->
- (try Some (snd (BatString.split name ".")) with _ -> None) = Some suff)
- (match Path.find t f with Path.Directory l -> l | _ -> []))
-
- let filename_of_path_relative t f = function
- | Relative, l_b, suff -> filename_of_path t f l_b suff
- | Absolute, _, _ -> assert false
-
- let filename_of_path_absolute t = function
- | Absolute, l_b, suff -> filename_of_path t Path.root l_b suff
- | _ -> assert false
-
- let empty = { lib = []
- ; bin = Relative, [], Suffix ""
- ; misc = [] }
-
- let b_of_string abs s =
- let l = BatString.nsplit (BatString.strip ~chars:"/" s) "/" in
- match List.rev l with
- | x :: xs ->
- abs,
- BatList.map (fun s -> B s) (List.rev xs),
- (match try Some (BatString.split x "*.") with _ -> None with
- | Some ("", suff) -> Suffix suff
- | _ -> Exact x)
- | [] -> abs, [], Exact ""
-
- let relative_path_of_string = b_of_string Relative
-
- let find t f =
- match Path.find t f with
- | Path.File (Binary s) ->
-
- let l_lib_bin, l_misc =
- let l, f_while =
- BatString.nsplit s "\n",
- fun s ->
- match try Some (BatString.split "misc" (BatString.trim s)) with _ -> None with
- | Some ("", _) -> true
- | _ -> false in
- BatList.take_while f_while l, BatList.drop_while f_while l in
-
- (match filter ":" l_lib_bin with
- | ("lib", lib)
- :: ("bin", bin) :: _ ->
- { lib = BatList.map relative_path_of_string (BatString.nsplit lib ",")
- ; bin = relative_path_of_string bin
- ; misc =
- BatList.map
- (fun (s_path, s_fname) ->
- { p_from = relative_path_of_string s_path ; p_to = b_of_string Absolute s_fname })
- (filter " " l_misc) }
- | _ -> empty)
-
- | _ -> empty
-
-
- let to_string t =
-
- let path_print oc (pref, l_base, base) =
- begin
- BatString.print oc (match pref with Absolute -> "/" | Relative -> "");
- BatList.print ~first:"" ~last:"/" ~sep:"/" (fun oc (B base) -> BatString.print oc base) oc l_base;
- BatString.print oc (match base with Suffix s -> Printf.sprintf "*.%s" s | Exact s -> s);
- end in
-
- Printf.sprintf "
-lib: %s
-bin: %s
-misc:
-%s"
- (BatIO.to_string (BatList.print ~first:"" ~last:"" ~sep:", " path_print) t.lib)
- (BatIO.to_string path_print t.bin)
- (BatIO.to_string (BatList.print ~first:"" ~last:"" ~sep:"\n"
- (fun oc misc ->
- begin
- path_print oc (misc.p_from);
- BatString.print oc " ";
- path_print oc (misc.p_to);
- end)) t.misc)
-
- let add t f v = Path.add t f (Path.File (Binary (to_string v)))
- end
-end
+open Server
type 'a installed_status =
| Was_installed of 'a
@@ -727,117 +38,6 @@ sig
(** Given a description of packages, it returns a list of solution preserving the consistency of the initial description. *)
end
-module type SERVER =
-sig
- type t
- type opam
- type package
-
- val init : Path.url option -> t
-
- val change_url : t -> Path.url -> t
-
- val getList : t -> name_version list
- (** Returns the list of the available versions for all
- packages. *)
-
- val getOpam : t -> name_version -> opam
- (** Returns the representation of
- the OPAM file for the corresponding package version. *)
-
- val getArchive : t -> opam -> binary_data archive
- (** Returns the corresponding package archive. *)
-
- val newArchive : t -> opam -> binary_data archive -> t
- (** Receives an upload, it contains an OPAM file and the
- corresponding package archive. *)
-
- val version_opam : t -> internal_version
- val version_ocaml : t -> internal_version
-
- val package : opam -> package option
- (** [None] : the [opam] associated to the [(name, version)] does not exist.
- Note that every [(name, version)] given by [getList] do exist. *)
-end
-
-module Server
- (F_config : File.CONFIG)
- (F_cudf : File.CUDF)
- : SERVER with type package = Cudf.package =
-struct
- module Path_map = BatMap.Make (struct type t = Path.t let compare = Path.compare_computer end)
-
- type t =
- { current_repository : Cudf.package NV_map.t
- ; home : Path.t (* ~/.opam-server *)
- ; all_repository : Cudf.package NV_map.t Path_map.t
- ; version_package_manager : internal_version
- ; version_ocaml : internal_version }
-
- type opam = name_version * Cudf.package option
- (* [None] : the current repository does not contain the package associated to the [name] and [version] *)
-
- type package = Cudf.package
-
- let read_archives home =
- let archives = Path.archives_targz home None in
- List.fold_left
- (fun map x ->
- NV_map.add
- (Namespace.nv_of_string (Path.chop_extension x))
- (F_cudf.package (F_cudf.find home (Path.concat archives x)))
- map) NV_map.empty
- (match Path.find home archives with
- | Path.Directory l -> l
- | _ -> [])
-
- let init o =
- let version_ocaml = F_config.empty_ocaml in
- let home = Path.init o ".opam-server" version_ocaml in
- { current_repository = read_archives home
- ; home
- ; all_repository = Path_map.empty
- ; version_package_manager = F_config.empty_package_manager
- ; version_ocaml }
-
- let change_url t url =
- let home = Path.change_url t.home url in
- { t with
- current_repository = (match Path_map.Exceptionless.find home t.all_repository with
- | None -> read_archives home
- | Some v -> v);
- home;
- all_repository = Path_map.add t.home t.current_repository t.all_repository }
-
- let getList t = BatList.map fst (NV_map.bindings t.current_repository)
- let getOpam t n_v = n_v, NV_map.Exceptionless.find n_v t.current_repository
- let getArchive t = function
- | _, None -> Empty
- | n_v, Some _ ->
- match Path.find t.home (Path.archives_targz t.home (Some n_v)) with
- | Path.File s -> Tar_gz s
- | _ -> Empty
-
- let newArchive t (n_v, o_pack) arch =
- let t =
- { t with
- home =
- Path.add
- t.home
- (Path.archives_targz t.home (Some n_v))
- (Path.File (match arch with
- | Empty -> failwith "create an empty tar.gz here"
- | Tar_gz s -> s)) } in
-
- match o_pack with
- | None -> { t with current_repository = NV_map.add n_v (F_cudf.new_package n_v "") t.current_repository }
- | Some _ -> t
-
- let version_opam t = t.version_package_manager
- let version_ocaml t = t.version_ocaml
- let package = snd
-end
-
module type CLIENT =
sig
type t
View
279 path.ml
@@ -0,0 +1,279 @@
+open Namespace
+
+type 'a ocaml_options =
+ | I of 'a
+
+type binary_data =
+ | Binary of string (* contents *)
+ | Filename of string (* pointer to the contents *)
+
+type 'a archive =
+ | Tar_gz of 'a
+ | Empty
+
+type basename = B of string
+
+type internal_version = Version of string
+(** Type used to represent an internal form of version, which is in particular not related to the version of a particular package *)
+
+module type PATH =
+sig
+
+ type t
+ type filename
+ type url
+
+ type 'a contents =
+ | Directory of basename list
+ | File of 'a
+ | Not_exists
+
+ type 'a contents_rec =
+ | R_directory of (basename * 'a contents_rec) list
+ | R_file of 'a
+ | R_filename of filename list
+
+ val init : url option (* [None] : local *) -> string (* $HOME_OPAM *) -> internal_version (* OVERSION *) -> t
+ (* $HOME_OPAM_OVERSION = $HOME_OPAM/OVERSION *)
+
+ (** definitions of some shortcuts *)
+ val root : filename (* / *)
+ (** the root of every path *)
+ val package : t -> filename (* $PWD *)
+ (** path in the packager filesystem, contains the collection of libraries and programs *)
+ val lib : t -> Namespace.name -> filename (* $HOME_OPAM_OVERSION/lib/NAME *)
+ (** installed libraries for the package (at most one version installed) *)
+ val bin : t -> filename (* $HOME_OPAM_OVERSION/bin *)
+ (** contain installed binaries *)
+ val config : t -> filename (* $HOME_OPAM/config *)
+ (** main configuration file *)
+ val installed : t -> filename (* $HOME_OPAM_OVERSION/installed *)
+ (** list of installed packages with their version *)
+ val index_opam : t -> name_version option -> filename (* $HOME_OPAM/index/NAME-VERSION.opam *)
+ (** OPAM files considered for an arbitrary version and package *)
+ val index_opam_list : t -> name_version list (* [ $HOME_OPAM/index/NAME-VERSION.opam ] -> [ NAME, VERSION ] *)
+ (** list of OPAM files *)
+ val archives_targz : t -> name_version option -> filename (* $HOME_OPAM/archives/NAME-VERSION.tar.gz *)
+ (** source archives for all versions of all packages *)
+ val build : t -> name_version option -> filename (* $HOME_OPAM_OVERSION/build/NAME-VERSION *)
+ (** tempory folders used to decompress the corresponding archives *)
+ val to_install : t -> name_version -> filename (* $HOME_OPAM_OVERSION/build/NAME-VERSION/NAME.install *)
+ (** compiled files in the extracted archive to install *)
+
+ (** **)
+
+ val find : t -> filename -> binary_data contents
+ (** Retrieves the contents from the hard disk. *)
+
+ val remove : t -> filename -> t
+ (** Removes everything in [filename] if existed. *)
+
+ val add : t -> filename -> binary_data contents -> t
+ (** Removes everything in [filename] if existed, then write [contents] instead. *)
+
+ val add_rec : t -> filename -> binary_data contents_rec -> t
+ (** Removes everything in [filename] if existed, then write [contents_rec] inside [filename]. *)
+
+ val extract_targz : t -> binary_data archive -> binary_data contents_rec
+ (** Returns the same meaning as [archive] but in extracted form. *)
+
+ val exec_buildsh : t -> name_version -> t
+ (* $HOME_OPAM/build/NAME-VERSION/build.sh *)
+ (** Executes this particularly named script. *)
+
+ val dirname : filename -> filename
+ (** see [Filename.dirname] *)
+
+ val basename : filename -> basename
+ (** see [Filename.basename] *)
+
+ val chop_extension : basename -> string
+ (** see [Filename.chop_extension] *)
+
+ val concat : filename -> basename -> filename
+ (** see [Filename.concat] *)
+
+ val file_exists : filename -> bool
+ (** see [Sys.file_exists] *)
+
+ val ocaml_options_of_library : t -> Namespace.name -> string ocaml_options
+ (* $HOME_OPAM/lib/NAME *)
+ (** Returns the exact path to give to the OCaml compiler (ie. -I ...) *)
+
+ val url : string (* hostname *) -> int option (* port *) -> url
+ val change_url : t -> url -> t
+ val string_of_url : url -> string
+ (** in the format "HOSTNAME:PORT" *)
+ val compare_computer : t -> t -> int
+end
+module Path : PATH = struct
+ open Printf
+
+ type url = U of string
+
+ type filename =
+ | Normalized of string
+ | Raw of string
+
+ type t = { computer : url option (* [None] : local *)
+ ; home : string
+ ; home_ocamlversion : string }
+
+ type 'a contents =
+ | Directory of basename list
+ | File of 'a
+ | Not_exists
+
+ type 'a contents_rec =
+ | R_directory of (basename * 'a contents_rec) list
+ | R_file of 'a
+ | R_filename of filename list
+
+ let s_of_filename = function
+ | Normalized s -> s
+ | Raw s -> s
+
+ let filename_map f = function
+ | Normalized s -> Normalized (f s)
+ | Raw s -> Raw (f s)
+
+ let normalize s =
+ let getchdir s =
+ let p = Unix.getcwd () in
+ let () = Unix.chdir s in
+ p in
+
+ Normalized (getchdir (getchdir s))
+
+ let home = Unix.getenv "HOME"
+ let (//) = sprintf "%s/%s"
+ let concat f (B s) = filename_map (fun filename -> filename // s) f
+ let (///) = concat
+ let init o s (Version ocamlv) =
+ let home = home // s in
+ { computer = o ; home ; home_ocamlversion = home // ocamlv }
+
+ let root = Raw "/"
+ let package _ = normalize "."
+ let lib t (Namespace.Name n) = Raw (t.home_ocamlversion // "lib" // n)
+ let bin t = Raw (t.home_ocamlversion // "bin")
+
+ let mk_name_version t_home d ext n v = Raw (t_home // d // sprintf "%s%s" (Namespace.string_of_nv n v) ext)
+
+ let mk_name_version_o t_home name ext =
+ function
+ | None -> Raw (t_home // name)
+ | Some (n, v) -> mk_name_version t_home name ext n v
+
+ let index_opam t = mk_name_version_o t.home "index" ".opam"
+ let archives_targz t = mk_name_version_o t.home "archives" ".tar.gz"
+
+ let build t = mk_name_version_o t.home_ocamlversion "build" ""
+ let installed t = Raw (t.home_ocamlversion // "installed")
+ let config t = Raw (t.home // "config")
+
+ let to_install t (n, v) = build t (Some (n, v)) /// B (Namespace.string_of_name n ^ ".install")
+
+ let url x o = U (sprintf "%s%s" x (match o with None -> "" | Some i -> sprintf ":%d" i))
+
+ let change_url t u = { t with computer = Some u }
+
+ let contents f_dir f_fic f_not_exists t f =
+ match t.computer with
+ | None ->
+ let fic = s_of_filename f in
+ if Sys.file_exists fic then
+ (if Sys.is_directory fic then f_dir else f_fic) fic
+ else
+ f_not_exists
+ | Some _ -> failwith "to complete !"
+
+
+ let find =
+ contents
+ (fun fic -> Directory (BatList.of_enum (BatEnum.map (fun s -> B s) (BatSys.files_of fic))))
+ (fun fic -> File ((*Binary (BatFile.with_file_in fic BatIO.read_all)*)Filename fic))
+ Not_exists
+
+ let chop_extension (B s) = Filename.chop_extension s
+ let file_exists f = Sys.file_exists (s_of_filename f)
+
+ let index_opam_list t =
+ BatList.map (fun fic -> Namespace.nv_of_string (chop_extension fic))
+ (match find t (index_opam t None) with
+ | Directory l -> l
+ | _ -> [])
+
+ let remove t f =
+ let rec aux fic =
+ match (Unix.lstat fic).Unix.st_kind with
+ | Unix.S_DIR ->
+ let () = BatEnum.iter (fun f -> aux (fic // f)) (BatSys.files_of fic) in
+ Unix.rmdir fic
+ | Unix.S_REG -> Unix.unlink fic
+ | _ -> failwith "to complete !" in
+ let () = aux (s_of_filename f) in
+ t
+
+ let add t f =
+ function
+ | Directory d -> failwith "to complete !"
+ | File (Binary cts) ->
+ let () = contents (fun _ -> failwith "to complete !") Unix.unlink () t f in
+ let fic = s_of_filename f in
+ let () = BatFile.with_file_out fic (fun oc -> BatString.print oc cts) in
+ t
+ | File (Filename fic) -> failwith "to complete ! copy the given filename"
+ | Not_exists -> failwith "to complete !"
+
+ let compare_computer t1 t2 = compare t1.computer t2.computer
+
+ let exec_buildsh t n_v =
+ let _ = Sys.chdir (s_of_filename (build t (Some n_v))) in
+ let _ = Sys.command "build.sh" in
+ t
+ let basename s = B (Filename.basename (s_of_filename s))
+
+ let extract_targz t = function
+ | Tar_gz (Binary _) -> failwith "to complete ! check if the \"dose\" project has been configured with the correct option to extract the gzip or bz2, then use similars functions to extract" (*IO.read_all (Common.Input.open_file fic)*)
+ | Tar_gz (Filename fic) -> R_filename [Raw fic]
+ | Empty -> R_directory []
+
+ let lstat s = Unix.lstat (s_of_filename s)
+ let files_of f = BatSys.files_of (s_of_filename f)
+
+ let dirname = filename_map Filename.dirname
+
+ let add_rec t f =
+ let () = (* check that [f] is not a file *)
+ contents
+ (fun _ -> ())
+ (fun _ -> failwith "to complete !")
+ () t f in
+
+ let rec aux t f (* <- filename dir *) name (* name of the value that will be destructed*) = function
+ | R_directory l ->
+ List.fold_left
+ (let f = f /// name in
+ fun t (b, cts) -> aux t f b cts) t l
+ | R_file cts -> add t (f /// name) (File cts)
+ | R_filename l ->
+ List.fold_left
+ (fun t fic ->
+ aux
+ t
+ f
+ (basename fic)
+ (match (lstat fic).Unix.st_kind with
+ | Unix.S_DIR -> R_directory (BatList.map (fun f ->
+ let f = B f in
+ f, R_filename [fic /// f]) (files_of fic))
+ | Unix.S_REG -> R_file (Filename (s_of_filename fic))
+ | _ -> failwith "to complete !")) t l in
+ aux t (dirname f) (basename f)
+
+ let ocaml_options_of_library t name =
+ I (Printf.sprintf "%s" (s_of_filename (lib t name)))
+
+ let string_of_url (U s) = s
+end
View
126 server.ml
@@ -0,0 +1,126 @@
+open Namespace
+open Path
+open File
+
+module type SERVER =
+sig
+ type t
+ type opam
+ type package
+
+ type api =
+ | GetList of t
+ | GetOpam of t * name_version
+ | GetArchive of t * opam
+ | NewArchive of t * opam * binary_data archive
+
+ val init : Path.url option -> t
+
+ val change_url : t -> Path.url -> t
+
+ val getList : t -> name_version list
+ (** Returns the list of the available versions for all
+ packages. *)
+
+ val getOpam : t -> name_version -> opam
+ (** Returns the representation of
+ the OPAM file for the corresponding package version. *)
+
+ val getArchive : t -> opam -> binary_data archive
+ (** Returns the corresponding package archive. *)
+
+ val newArchive : t -> opam -> binary_data archive -> t
+ (** Receives an upload, it contains an OPAM file and the
+ corresponding package archive. *)
+
+ val version_opam : t -> internal_version
+ val version_ocaml : t -> internal_version
+
+ val package : opam -> package option
+ (** [None] : the [opam] associated to the [(name, version)] does not exist.
+ Note that every [(name, version)] given by [getList] do exist. *)
+end
+
+module Server
+ (F_config : File.CONFIG)
+ (F_cudf : File.CUDF)
+ : SERVER with type package = Cudf.package =
+struct
+ module Path_map = BatMap.Make (struct type t = Path.t let compare = Path.compare_computer end)
+
+ type t =
+ { current_repository : Cudf.package NV_map.t
+ ; home : Path.t (* ~/.opam-server *)
+ ; all_repository : Cudf.package NV_map.t Path_map.t
+ ; version_package_manager : internal_version
+ ; version_ocaml : internal_version }
+
+ type opam = name_version * Cudf.package option
+ (* [None] : the current repository does not contain the package associated to the [name] and [version] *)
+
+ type package = Cudf.package
+
+ type api =
+ | GetList of t
+ | GetOpam of t * name_version
+ | GetArchive of t * opam
+ | NewArchive of t * opam * binary_data archive
+
+ let read_archives home =
+ let archives = Path.archives_targz home None in
+ List.fold_left
+ (fun map x ->
+ NV_map.add
+ (Namespace.nv_of_string (Path.chop_extension x))
+ (F_cudf.package (F_cudf.find home (Path.concat archives x)))
+ map) NV_map.empty
+ (match Path.find home archives with
+ | Path.Directory l -> l
+ | _ -> [])
+
+ let init o =
+ let version_ocaml = F_config.empty_ocaml in
+ let home = Path.init o ".opam-server" version_ocaml in
+ { current_repository = read_archives home
+ ; home
+ ; all_repository = Path_map.empty
+ ; version_package_manager = F_config.empty_package_manager
+ ; version_ocaml }
+
+ let change_url t url =
+ let home = Path.change_url t.home url in
+ { t with
+ current_repository = (match Path_map.Exceptionless.find home t.all_repository with
+ | None -> read_archives home
+ | Some v -> v);
+ home;
+ all_repository = Path_map.add t.home t.current_repository t.all_repository }
+
+ let getList t = BatList.map fst (NV_map.bindings t.current_repository)
+ let getOpam t n_v = n_v, NV_map.Exceptionless.find n_v t.current_repository
+ let getArchive t = function
+ | _, None -> Empty
+ | n_v, Some _ ->
+ match Path.find t.home (Path.archives_targz t.home (Some n_v)) with
+ | Path.File s -> Tar_gz s
+ | _ -> Empty
+
+ let newArchive t (n_v, o_pack) arch =
+ let t =
+ { t with
+ home =
+ Path.add
+ t.home
+ (Path.archives_targz t.home (Some n_v))
+ (Path.File (match arch with
+ | Empty -> failwith "create an empty tar.gz here"
+ | Tar_gz s -> s)) } in
+
+ match o_pack with
+ | None -> { t with current_repository = NV_map.add n_v (F_cudf.new_package n_v "") t.current_repository }
+ | Some _ -> t
+
+ let version_opam t = t.version_package_manager
+ let version_ocaml t = t.version_ocaml
+ let package = snd
+end
Please sign in to comment.
Something went wrong with that request. Please try again.