libguestfs.ml

   1 (* Helper functions for handling libguestfs. *)
   2
   3 open Goaljobs
   4
   5 open Printf
   6
   7 open Config
   8 open Utils
   9
  10 let package = "libguestfs"
  11
  12 (* Helper object which stores everything about a version. *)
  13 type info = {
  14   version : string;              (* The version as a normal string. *)
  15   major : int;                   (* Broken-out version fields. *)
  16   minor : int;
  17   release: int;
  18   is_stable : bool;              (* is a stable version of libguestfs? *)
  19   branch : string;               (* 'master' or 'stable-1.xx' *)
  20   package_version : string;      (* package-version *)
  21   tarball : string;              (* package-version.tar.gz *)
  22   urlpath : string;              (* download/1.X-(stable|development)/tarball *)
  23   url : string;                  (* full download URL of tarball *)
  24 }
  25
  26 let compare_versions { major = major1; minor = minor1; release = release1 }
  27     { major = major2; minor = minor2; release = release2 } =
  28   compare (major1, minor1, release1) (major2, minor2, release2)
  29
  30 let string_of_libguestfs_version { version = version } = version
  31
  32 (* Helper function to make a full 'info' object from a version
  33  * number.
  34  *)
  35 let vernames version =
  36   Scanf.sscanf version "%d.%d.%d" (
  37     fun major minor release ->
  38       let is_stable = minor mod 2 = 0 in
  39       let branch =
  40         if is_stable then
  41           sprintf "stable-%d.%d" major minor
  42         else
  43           sprintf "master" in
  44       let package_version = sprintf "%s-%d.%d.%d" package major minor release in
  45       let tarball = sprintf "%s.tar.gz" package_version in
  46       let urlpath =
  47         if is_stable then
  48           sprintf "download/%d.%d-stable/%s" major minor tarball
  49         else
  50           sprintf "download/%d.%d-development/%s" major minor tarball in
  51       let url = "http://libguestfs.org/" ^ urlpath in
  52       { version = version;
  53         major = major; minor = minor; release = release;
  54         is_stable = is_stable;
  55         branch = branch;
  56         package_version = package_version;
  57         tarball = tarball;
  58         urlpath = urlpath;
  59         url = url }
  60   )
  61
  62 (* For libguestfs <= 1.24, we need an old supermin 4 binary. *)
  63 let supermin = function
  64   | { major = 1; minor = i } when i <= 24 ->
  65     let home = Sys.getenv "HOME" in
  66     Some ( home // "d/supermin4/src/supermin",
  67            home // "d/supermin4/helper/supermin-helper" )
  68   | _ -> None
  69
  70 (* Clone or update a repo to the latest version on a branch, by force.
  71  * It is cached in name = $buildtmp/repos/<package>-<branch>
  72  *)
  73 let git_force branch =
  74   let url = "https://github.com/libguestfs/libguestfs.git"  in
  75   sh "
  76     cd %s/repos
  77     if [ ! -d %s-%s ]; then git clone %s %s-%s; fi
  78     cd %s-%s
  79     git checkout --force %s
  80     git pull
  81     # Copy or update gnulib
  82     git submodule init
  83     git submodule update
  84   " buildtmp
  85     package (quote branch) (quote url) package (quote branch)
  86     package (quote branch)
  87     (quote branch)
  88
  89 (* Helper function to read the latest version in a repo and return
  90  * the version.
  91  *)
  92 let git_latest_version branch =
  93   let v = shout "
  94     cd %s/repos/%s-%s
  95     git describe --tags --abbrev=0
  96   " buildtmp package (quote branch) in
  97   vernames v
  98
  99 (* Get the latest commit. *)
 100 let git_latest_commit branch =
 101   shout "
 102     cd %s/repos/%s-%s
 103     git rev-parse HEAD
 104   " buildtmp package (quote branch)
 105
 106 (* Find the latest website tarball version.  Actually we use our local
 107  * CVS copy of the website rather than downloading from
 108  * http://libguestfs.org
 109  *)
 110 let website_latest_version =
 111   let rex = Str.regexp "libguestfs-\\(.*\\)\\.tar\\.gz" in
 112   fun branch ->
 113     let wdir = libguestfs_website_repo // "download" // branch in
 114     let files = Sys.readdir wdir in
 115     let files = Array.to_list files in
 116     if files = [] then None
 117     else (
 118       let versions = filter_map (
 119         fun name ->
 120           if not (Str.string_match rex name 0) then None
 121           else Some (vernames (Str.matched_group 1 name))
 122       ) files in
 123       let versions = List.sort compare_versions versions in
 124       let versions = List.rev versions in
 125       Some (List.hd versions)
 126     )