libguestfs_upstream.ml

   1 (* This goal script is responsible for:
   2  *  - testing each new commit to the libguestfs source repo
   3  *  - checking for new upstream releases of libguestfs
   4  *  - testing new upstream releases
   5  *  - packaging them as a source tarball
   6  *  - testing the source tarball on a variety of systems
   7  *  - if all the above works, uploading the external website
   8  * Note this doesn't build the Fedora releases.  See 'libguestfs_fedora.ml'.
   9  *)
  10
  11 open Goaljobs
  12 open Printf
  13 open Config
  14
  15 (* Enable debugging. *)
  16 let () =
  17   Unix.putenv "LIBGUESTFS_DEBUG" "1";
  18   Unix.putenv "LIBGUESTFS_TRACE" "1"
  19
  20 (* Log program output. *)
  21 let from = "rjones@redhat.com"
  22 let to_ = "rjones@redhat.com"
  23 let logfile = log_program_output ()
  24 let () = eprintf "logging to %s\n%!" logfile
  25
  26 let package = "libguestfs"
  27
  28 (* Helper object which stores everything about a version. *)
  29 type info = {
  30   version : string;              (* The version as a normal string. *)
  31   major : int;                   (* Broken-out version fields. *)
  32   minor : int;
  33   release: int;
  34   is_stable : bool;              (* is a stable version of libguestfs? *)
  35   branch : string;               (* 'master' or 'stable-1.xx' *)
  36   package_version : string;      (* package-version *)
  37   tarball : string;              (* package-version.tar.gz *)
  38   urlpath : string;              (* download/1.X-(stable|development)/tarball *)
  39   url : string;                  (* full download URL of tarball *)
  40 }
  41
  42 (* Helper: Fetch latest gnulib into $buildtmp/repos/gnulib
  43  * XXX Move to Gnulib module.
  44  *)
  45 let get_gnulib () =
  46   sh "
  47     cd %s/repos
  48     if [ ! -d gnulib ]; then git clone git://git.sv.gnu.org/gnulib.git; fi
  49     cd gnulib
  50     git checkout --force master
  51     git pull
  52   " buildtmp
  53
  54 (* Goal: the website has been updated to 'version'. *)
  55 let rec goal website_updated version =
  56   target (url_exists version.url);
  57
  58   require (tarball_created version);
  59   require (tarball_tested version);
  60
  61   (* We only update the website for the development releases. *)
  62   if not version.is_stable then
  63     require (website_built version);
  64
  65   require (website_cvs_checked_in version);
  66   require (website_rsync_done version)
  67
  68 (* Goal: website has been rsync'd. *)
  69 and website_rsync_done version =
  70   let key = sprintf "libguestfs_website_rsync_done_%s" version.version in
  71   target (memory_exists key);
  72   onrun (fun () -> memory_set key "1");
  73
  74   sh "
  75     cd %s
  76     echo NOT RUNNING: . .rsync
  77   " libguestfs_website_cvs
  78
  79 (* Goal: Tarball added to CVS and CVS checked in. *)
  80 and website_cvs_checked_in version =
  81   let key = sprintf "libguestfs_website_cvs_checked_in_%s" version.version in
  82   target (memory_exists key);
  83   onrun (fun () -> memory_set key "1");
  84
  85   require (tarball_created version);
  86   require (tarball_tested version);
  87
  88   sh "
  89     cd %s
  90     cp %s/tarballs/%s %s
  91     echo NOT RUNNING: cvs add -kb %s
  92     echo NOT RUNNING: cvs ci -m \"Version %s\"
  93   " libguestfs_website_cvs
  94     buildtmp version.tarball version.urlpath
  95     version.urlpath
  96     version.version
  97
  98 (* Goal: website (local copy) has been built. *)
  99 and website_built version =
 100   let index_file = sprintf "%s/index.html" libguestfs_website_cvs in
 101   target (file_contains_string index_file version.version);
 102
 103   require (tarball_created version);
 104   require (tarball_tested version);
 105
 106   (* We should only update the website on development releases. *)
 107   assert (not version.is_stable);
 108
 109   sh "
 110     tar zxf %s/tarballs/%s
 111     cd %s
 112
 113     echo %s > localconfigure
 114     chmod +x localconfigure
 115     echo %s > localenv
 116
 117     ./localconfigure
 118     make
 119     make website
 120   " buildtmp version.tarball
 121     version.package_version
 122     (quote (libguestfs_localconfigure `Tarball))
 123     (quote libguestfs_localenv)
 124
 125 (* Goal: the tarball has passed the required set of tests before
 126  * a release is allowed.
 127  *)
 128 and tarball_tested version =
 129   let key = sprintf "libguestfs_tarball_tested_%s" version.version in
 130   target (memory_exists key);
 131   onrun (fun () -> memory_set key "1");
 132
 133   require (tarball_created version);
 134
 135   sh "
 136     tar zxf %s/tarballs/%s
 137     cd %s
 138
 139     echo %s > localconfigure
 140     chmod +x localconfigure
 141     echo %s > localenv
 142
 143     ./localconfigure
 144     make
 145     make check-release
 146   " buildtmp version.tarball
 147     version.package_version
 148     (quote (libguestfs_localconfigure `Tarball))
 149     (quote libguestfs_localenv)
 150
 151 (* Goal: the tarball has been created from git. *)
 152 and tarball_created version =
 153   let filename = sprintf "%s/tarballs/%s" buildtmp version.tarball in
 154   target (file_exists filename);
 155
 156   let repodir = sprintf "%s/repos/%s-%s" buildtmp package version.branch in
 157   require (directory_exists repodir);
 158
 159   sh "
 160     cp -a %s libguestfs
 161     cd libguestfs
 162     git reset --hard %s
 163
 164     echo %s > localconfigure
 165     chmod +x localconfigure
 166     echo %s > localenv
 167
 168     ./localconfigure
 169     make
 170     make dist
 171     mv %s %s/tarballs/%s
 172   " repodir
 173     version.version
 174     (quote (libguestfs_localconfigure `Git))
 175     (quote libguestfs_localenv)
 176     version.tarball buildtmp version.tarball
 177
 178 (* Goal: test a commit. *)
 179 and commit_tested branch commit =
 180   onfail (
 181     fun _ ->
 182       let subject = sprintf "goal: %s: FAILED" goalname in
 183       mailto ~from ~subject ~attach:[logfile] to_
 184   );
 185
 186   let key = sprintf "libguestfs_commit_tested_%s" commit in
 187   target (memory_exists key);
 188   onrun (fun () -> memory_set key "1");
 189
 190   let repodir = sprintf "%s/repos/%s-%s" buildtmp package branch in
 191   require (directory_exists repodir);
 192
 193   sh "
 194     cp -a %s libguestfs
 195     cd libguestfs
 196     git reset --hard %s
 197
 198     echo %s > localconfigure
 199     chmod +x localconfigure
 200     echo %s > localenv
 201
 202     ./localconfigure
 203     make
 204     make check-release
 205   " repodir
 206     commit
 207     (quote (libguestfs_localconfigure `Git))
 208     (quote libguestfs_localenv)
 209
 210 (* Helper function to make a full 'info' object from a version
 211  * number.
 212  *)
 213 let vernames version =
 214   Scanf.sscanf version "%d.%d.%d" (
 215     fun major minor release ->
 216       let is_stable = minor mod 2 = 0 in
 217       let branch =
 218         if is_stable then
 219           sprintf "stable-%d.%d" major minor
 220         else
 221           sprintf "master" in
 222       let package_version = sprintf "%s-%d.%d.%d" package major minor release in
 223       let tarball = sprintf "%s.tar.gz" package_version in
 224       let urlpath =
 225         if is_stable then
 226           sprintf "download/%d.%d-stable/%s" major minor tarball
 227         else
 228           sprintf "download/%d.%d-development/%s" major minor tarball in
 229       let url = "http://libguestfs.org/" ^ urlpath in
 230       { version = version;
 231         major = major; minor = minor; release = release;
 232         is_stable = is_stable;
 233         branch = branch;
 234         package_version = package_version;
 235         tarball = tarball;
 236         urlpath = urlpath;
 237         url = url }
 238   )
 239
 240 (* Helper function to read the latest version in a repo and return
 241  * the version.
 242  *)
 243 let git_latest_version branch =
 244   let v = shout "
 245     cd %s/repos/%s-%s
 246     git describe --tags --abbrev=0
 247   " buildtmp package (quote branch) in
 248   vernames v
 249
 250 (* Get the latest commit. *)
 251 let git_latest_commit branch =
 252   shout "
 253     cd %s/repos/%s-%s
 254     git rev-parse HEAD
 255   " buildtmp package (quote branch)
 256
 257 (* Clone or update a repo to the latest version on a branch, by force.
 258  * It is cached in name = $buildtmp/repos/<package>-<branch>
 259  *)
 260 let git_force url branch =
 261   sh "
 262     cd %s/repos
 263     if [ ! -d %s-%s ]; then git clone %s %s-%s; fi
 264     cd %s-%s
 265     git checkout --force %s
 266     git pull
 267     # Copy or update gnulib
 268     git submodule init
 269     git submodule update
 270   " buildtmp
 271     package (quote branch) (quote url) package (quote branch)
 272     package (quote branch)
 273     (quote branch)
 274
 275 let () =
 276   (* Add a periodic job to check for new git commits and test them. *)
 277   every libguestfs_query_mins minutes ~name:"new libguestfs commit" (
 278     fun () ->
 279       git_force "https://github.com/libguestfs/libguestfs.git" "master";
 280
 281       let commit = git_latest_commit "master" in
 282       require (commit_tested "master" commit);
 283   );
 284
 285   (* Periodic job to build new tarballs. *)
 286   every libguestfs_query_mins minutes ~name:"new libguestfs version" (
 287     fun () ->
 288       git_force "https://github.com/libguestfs/libguestfs.git" "master";
 289
 290       let version = git_latest_version "master" in
 291       require (website_updated version)
 292   )
 293
 294 (* Allow these jobs to run from the command line. *)
 295 let () =
 296   publish "commit" (
 297     function
 298     | [commit] -> require (commit_tested "master" commit)
 299     | [branch; commit] -> require (commit_tested branch commit)
 300     | _ ->
 301       failwith "use './libguestfs_upstream commit [<branch>] <commit>'"
 302   );
 303   publish "release" (
 304     function
 305     | [version] -> require (website_updated (vernames version))
 306     | _ ->
 307       failwith "use './libguestfs_upstream release <version>'"
 308   )