Permalink
Browse files

Cool new features

* you can have add a field "urls" to the .spec file to specify alternative locations to download packages. So you don't have to provide an archive when you upload the file.
* you can give a full xxx.spec name (which doesn't have to follow any naming convention) to ocp-get upload. The file will be renamed by the server automatically.
  • Loading branch information...
samoht committed Mar 22, 2012
1 parent acd90fc commit 8afaa5932e79a93f1518828f9a26a48053fd6f0a
Showing with 267 additions and 143 deletions.
  1. +2 −0 ocp-get.ocp
  2. +26 −16 src/client.ml
  3. +10 −7 src/file.ml
  4. +7 −1 src/file_format.ml
  5. +20 −8 src/globals.ml
  6. +1 −1 src/ocp_get.ml
  7. +4 −1 src/ocp_get_server.ml
  8. +20 −103 src/path.ml
  9. +165 −0 src/run.ml
  10. +1 −1 src/server.ml
  11. +3 −5 tests/Makefile
  12. 0 tests/packages/{P1.spec.2 → P1-2.spec}
  13. +8 −0 tests/packages/P4-2.spec
View
@@ -182,6 +182,7 @@ begin library "ocp-get-lib"
"lexer.mll"
"parser.mly"
"namespace.ml"
+ "run.ml"
"path.ml"
"file.ml"
"protocol.ml"
@@ -193,6 +194,7 @@ begin library "ocp-get-lib"
"dose"
"bat"
"unix"
+ "extlib"
"ocaml-arg"
]
end
View
@@ -241,7 +241,7 @@ module Client : CLIENT = struct
| p -> Globals.error_and_exit "invalid program name %s" (string_of_path p) in
(* XXX: use the API *)
- U.copy (Path.string_of_filename src) (Path.string_of_filename dst)
+ Run.copy (Path.string_of_filename src) (Path.string_of_filename dst)
) (File.To_install.bin to_install);
(* misc *)
@@ -309,7 +309,7 @@ module Client : CLIENT = struct
(* Then, untar the archive *)
let p_build = Path.build t.home (Some nv) in
Path.remove p_build;
- let tgz = Path.extract_targz (RemoteServer.getArchive t.server nv) in
+ let tgz = Path.extract_targz nv (RemoteServer.getArchive t.server nv) in
log "untar archive for %s" (Namespace.to_string nv);
Path.add_rec p_build tgz;
@@ -456,28 +456,38 @@ module Client : CLIENT = struct
| Some v -> vpkg_of_nv (name, V_set.max_elt v))
(N_map.bindings installed) } ]
- (* Upload reads NAME.opam to get the current package version.
- Then it looks for NAME-VERSION.tar.gz in the same directory.
- Then, it sends both NAME.opam and NAME-VERSION.tar.gz to the server *)
+ (* Upload reads NAME.spec (or NAME if it ends .spec) to get the current package version.
+ Then it looks for NAME-VERSION.tar.gz in the same directory (if it exists).
+ If not, it looks for provided URLs.
+ Then, it sends both NAME.spec and NAME-VERSION.tar.gz to the server *)
let upload name =
log "upload %s" name;
let t = load_state () in
(* Get the current package version *)
- let opam_filename = name ^ ".spec" in
- let opam_binary = U.read_content opam_filename in
- let opam = File.Spec.parse opam_binary in
- let version = File.Spec.version opam in
- let opam = binary opam_binary in
+ let spec_f =
+ if Filename.check_suffix name "spec" then
+ name
+ else
+ name ^ ".spec" in
+ let spec_s = Run.read spec_f in
+ let spec = File.Spec.parse spec_s in
+ let version = File.Spec.version spec in
+ let name = File.Spec.name spec in
+ let spec_b = binary spec_s in
(* look for the archive *)
let archive_filename =
Namespace.string_of_nv (Namespace.Name name) version ^ ".tar.gz" in
let archive =
if Sys.file_exists archive_filename then
- Tar_gz (binary (U.read_content archive_filename))
+ Tar_gz (binary (Run.read archive_filename))
else
- Globals.error_and_exit "Cannot find %s" archive_filename in
+ let urls = File.Spec.urls spec in
+ if urls = [] then
+ Globals.error_and_exit "Cannot find %s" archive_filename
+ else
+ Tar_gz (Filename (Raw_links urls)) in
(* Upload both files to the server and update the client
filesystem to reflect the new uploaded packages *)
@@ -488,12 +498,12 @@ module Client : CLIENT = struct
let o_key1 =
match o_key0 with
| None ->
- let o = RemoteServer.newArchive t.server (name, version) opam archive in
- let () = assert (o = Server.newArchive local_server (name, version) opam archive) in
+ let o = RemoteServer.newArchive t.server (name, version) spec_b archive in
+ let () = assert (o = Server.newArchive local_server (name, version) spec_b archive) in
o
| Some k ->
- let b = RemoteServer.updateArchive t.server (name, version) opam archive k in
- let () = assert (b = Server.updateArchive local_server (name, version) opam archive k) in
+ let b = RemoteServer.updateArchive t.server (name, version) spec_b archive k in
+ let () = assert (b = Server.updateArchive local_server (name, version) spec_b archive k) in
if b then Some k else None in
match o_key1 with
View
@@ -269,7 +269,7 @@ struct
let s_installed = " installed" (* see [Debcudf.add_inst] for more details about the format *)
let s_depends = "depends"
let s_conflicts = "conflicts"
- let s_url = "url"
+ let s_urls = "urls"
let description t = t.description
let name t = t.name
@@ -297,9 +297,11 @@ struct
let to_string t =
let pf (k, v) = Printf.sprintf " %s = %S\n" k v in
- Printf.sprintf "@%d\n\npackage %S {\n%s}\n"
+ let ps = Printf.sprintf "%S"in
+ Printf.sprintf "@%d\n\npackage %S {\n%s urls = [%s]\n}\n"
Globals.api_version t.name
(String.concat "" (List.map pf t.fields))
+ (String.concat "; " (List.map ps t.urls))
let parse str =
let lexbuf = Lexing.from_string str in
@@ -318,12 +320,13 @@ struct
| String s -> String.nsplit s "."
| _ -> Globals.error_and_exit "Fied 'description': bad format"
with Not_found -> [] in
- let urls = string_list s_url statement in
+ let urls = string_list s_urls statement in
let fields =
- let unstring (k,v) = match v with
- | String s -> k, s
- | _ -> Globals.error_and_exit "Field %s: bad format" k in
- List.map unstring statement.contents in
+ let unstring accu (k,v) =
+ match v with
+ | String s -> (k, s) :: accu
+ | _ -> accu in
+ List.fold_left unstring [] statement.contents in
{ version
; description
; fields
View
@@ -54,4 +54,10 @@ let pair_list n s =
let string n s =
try parse_string (List.assoc n s.contents)
- with Not_found -> Globals.error_and_exit "Bad format: field '%s' is missing" n
+ with Not_found -> Globals.error_and_exit "Bad format: field'%S is missing" n
+
+let rec string_of_content = function
+ | String s -> Printf.sprintf "%S" s
+ | List l ->
+ Printf.sprintf "[%s]"
+ (String.concat "; " (List.map string_of_content l))
View
@@ -51,14 +51,26 @@ let msg fmt =
Printf.printf "%s%!" str
) fmt
-
-
-
-
-
-
-
-
+type os =
+ | Darwin
+ | Linux
+ | FreeBSD
+ | Cygwin
+ | Win32
+ | Unix
+
+let os =
+ match Sys.os_type with
+ | "Unix" -> begin
+ match input_line (Unix.open_process_in "uname -s") with
+ | "Darwin" -> Darwin
+ | "Linux" -> Linux
+ | "FreeBSD" -> FreeBSD
+ | _ -> Unix
+ end
+ | "Win32" -> Win32
+ | "Cygwin" -> Cygwin
+ | _ -> assert false
View
@@ -42,7 +42,7 @@ let noanon s =
let () = Globals.root_path := Globals.default_opam_path
-let global_args = Arg.align [
+let global_args = [
"--debug" , Arg.Set Globals.debug, " Print more debug messages";
"--version", Arg.Unit version, " Display version information";
View
@@ -71,7 +71,10 @@ let log id fmt =
let protect f =
try f ()
- with e -> Oerror (Printexc.to_string e)
+ with e ->
+ let msg = Printexc.to_string e in
+ Globals.error "%s" msg;
+ Oerror msg
let fn t =
Random.self_init();
Oops, something went wrong.

0 comments on commit 8afaa59

Please sign in to comment.