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   python_tarball : string;       (* guestfs-version.tar.gz *)
  23   urlpath : string;              (* download/1.X-(stable|development)/tarball *)
  24   python_urlpath : string;       (* download/python/python_tarball *)
  25   url : string;                  (* full download URL of tarball *)
  26   python_url : string;           (* python sdist *)
  27 }
  28
  29 let compare_versions { major = major1; minor = minor1; release = release1 }
  30     { major = major2; minor = minor2; release = release2 } =
  31   compare (major1, minor1, release1) (major2, minor2, release2)
  32
  33 let string_of_libguestfs_version { version = version } = version
  34
  35 (* Helper function to make a full 'info' object from a version
  36  * number.
  37  *)
  38 let vernames version =
  39   Scanf.sscanf version "%d.%d.%d" (
  40     fun major minor release ->
  41       let is_stable = minor mod 2 = 0 in
  42       let branch =
  43         if is_stable then
  44           sprintf "stable-%d.%d" major minor
  45         else
  46           sprintf "master" in
  47       let package_version = sprintf "%s-%d.%d.%d" package major minor release in
  48       let tarball = sprintf "%s.tar.gz" package_version in
  49       let urlpath =
  50         if is_stable then
  51           sprintf "download/%d.%d-stable/%s" major minor tarball
  52         else
  53           sprintf "download/%d.%d-development/%s" major minor tarball in
  54       let url = "http://libguestfs.org/" ^ urlpath in
  55       let python_tarball =
  56         sprintf "guestfs-%d.%d.%d.tar.gz" major minor release in
  57       let python_urlpath = sprintf "download/python/" ^ python_tarball in
  58       let python_url = "http://libguestfs.org/" ^ python_urlpath in
  59
  60       { version = version;
  61         major = major; minor = minor; release = release;
  62         is_stable = is_stable;
  63         branch = branch;
  64         package_version = package_version;
  65         tarball = tarball;
  66         python_tarball = python_tarball;
  67         urlpath = urlpath;
  68         python_urlpath = python_urlpath;
  69         url = url;
  70         python_url = python_url }
  71   )
  72
  73 (* For libguestfs <= 1.24, we need an old supermin 4 binary. *)
  74 let supermin = function
  75   | { major = 1; minor = i } when i <= 24 ->
  76     let home = Sys.getenv "HOME" in
  77     Some ( home // "d/supermin4/src/supermin",
  78            home // "d/supermin4/helper/supermin-helper" )
  79   | _ -> None
  80
  81 (* Clone or update a repo to the latest version on a branch, by force.
  82  * It is cached in name = $buildtmp/repos/<package>-<branch>
  83  *)
  84 let git_force branch =
  85   let url = "https://github.com/libguestfs/libguestfs.git"  in
  86   sh "
  87     cd %s/repos
  88     if [ ! -d %s-%s ]; then git clone %s %s-%s; fi
  89     cd %s-%s
  90     git checkout --force %s
  91     git pull
  92     # Copy or update gnulib
  93     git submodule init
  94     git submodule update
  95   " buildtmp
  96     package (quote branch) (quote url) package (quote branch)
  97     package (quote branch)
  98     (quote branch)
  99
 100 (* Helper function to read the latest version in a repo and return
 101  * the version.
 102  *)
 103 let git_latest_version branch =
 104   let v = shout "
 105     cd %s/repos/%s-%s
 106     git describe --tags --abbrev=0
 107   " buildtmp package (quote branch) in
 108   (* Branches <= 1.32 are tagged with "1.32.11",
 109    * branches >= 1.33 are tagged with "v1.33.11".
 110    *)
 111   let len = String.length v in
 112   let v =
 113     if len > 0 && v.[0] = 'v' then
 114       String.sub v 1 (len-1)
 115     else
 116       v in
 117   vernames v
 118
 119 (* Get the latest commit. *)
 120 let git_latest_commit branch =
 121   shout "
 122     cd %s/repos/%s-%s
 123     git rev-parse HEAD
 124   " buildtmp package (quote branch)
 125
 126 (* Find the latest website tarball version.  Actually we use our local
 127  * CVS copy of the website rather than downloading from
 128  * http://libguestfs.org
 129  *)
 130 let website_latest_version =
 131   let rex = Str.regexp "libguestfs-\\(.*\\)\\.tar\\.gz" in
 132   fun branch ->
 133     let wdir = libguestfs_website_repo // "download" // branch in
 134     let files = Sys.readdir wdir in
 135     let files = Array.to_list files in
 136     if files = [] then None
 137     else (
 138       let versions = filter_map (
 139         fun name ->
 140           if not (Str.string_match rex name 0) then None
 141           else Some (vernames (Str.matched_group 1 name))
 142       ) files in
 143       let versions = List.sort compare_versions versions in
 144       let versions = List.rev versions in
 145       Some (List.hd versions)
 146     )