Implement logging.
[goaljobs-goals.git] / 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
73   sh "
74     cd %s
75     echo NOT RUNNING: . .rsync
76   " libguestfs_website_cvs;
77   memory_set key "1"
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
84   require (tarball_created version);
85   require (tarball_tested version);
86
87   sh "
88     cd %s
89     cp %s/tarballs/%s %s
90     echo NOT RUNNING: cvs add -kb %s
91     echo NOT RUNNING: cvs ci -m \"Version %s\"
92   " libguestfs_website_cvs
93     buildtmp version.tarball version.urlpath
94     version.urlpath
95     version.version
96
97 (* Goal: website (local copy) has been built. *)
98 and website_built version =
99   let index_file = sprintf "%s/index.html" libguestfs_website_cvs in
100   target (file_contains_string index_file version.version);
101
102   require (tarball_created version);
103   require (tarball_tested version);
104
105   (* We should only update the website on development releases. *)
106   assert (not version.is_stable);
107
108   sh "
109     tar zxf %s/tarballs/%s
110     cd %s
111     echo %s > localconfigure
112     chmod +x localconfigure
113     echo %s > localenv .
114     ./localconfigure
115     make
116     make website
117   " buildtmp version.tarball
118     version.package_version
119     (quote (libguestfs_localconfigure `Tarball))
120     (quote libguestfs_localenv)
121
122 (* Goal: the tarball has passed the required set of tests before
123  * a release is allowed.
124  *)
125 and tarball_tested version =
126   let key = sprintf "libguestfs_tarball_tested_%s" version.version in
127   target (memory_exists key);
128
129   require (tarball_created version);
130
131   sh "
132     tar zxf %s/tarballs/%s
133     cd %s
134     echo %s > localconfigure
135     chmod +x localconfigure
136     echo %s > localenv .
137     ./localconfigure
138     make
139     make check-release
140   " buildtmp version.tarball
141     version.package_version
142     (quote (libguestfs_localconfigure `Tarball))
143     (quote libguestfs_localenv)
144
145 (* Goal: the tarball has been created from git. *)
146 and tarball_created version =
147   let filename = sprintf "%s/tarballs/%s" buildtmp version.tarball in
148   target (file_exists filename);
149
150   let repodir = sprintf "%s/repos/%s-%s" buildtmp package version.branch in
151   require (directory_exists repodir);
152
153   sh "
154     cp -a %s libguestfs
155     cd libguestfs
156     git reset --hard %s
157
158     echo %s > localconfigure
159     chmod +x localconfigure
160     echo %s > localenv .
161
162     ./localconfigure
163     make
164     make dist
165     mv %s %s/tarballs/%s
166   " repodir
167     version.version
168     (quote (libguestfs_localconfigure `Git))
169     (quote libguestfs_localenv)
170     version.tarball buildtmp version.tarball
171
172 (* Goal: test a commit. *)
173 and commit_tested branch commit =
174   onfail (
175     fun _ ->
176       let subject = sprintf "goal: %s: FAILED" goalname in
177       mailto ~from ~subject ~attach:[logfile] to_
178   );
179
180   let key = sprintf "libguestfs_commit_tested_%s" commit in
181   target (memory_exists key);
182
183   let repodir = sprintf "%s/repos/%s-%s" buildtmp package branch in
184   require (directory_exists repodir);
185
186   sh "
187     cp -a %s libguestfs
188     cd libguestfs
189     git reset --hard %s
190
191     echo %s > localconfigure
192     chmod +x localconfigure
193     echo %s > localenv
194
195     ./localconfigure
196     make
197     make check-release
198   " repodir
199     commit
200     (quote (libguestfs_localconfigure `Git))
201     (quote libguestfs_localenv);
202
203   memory_set key "1"
204
205 (* Helper function to make a full 'info' object from a version
206  * number.
207  *)
208 let vernames version =
209   Scanf.sscanf version "%d.%d.%d" (
210     fun major minor release ->
211       let is_stable = minor mod 2 = 0 in
212       let branch =
213         if is_stable then
214           sprintf "stable-%d.%d" major minor
215         else
216           sprintf "master" in
217       let package_version = sprintf "%s-%d.%d.%d" package major minor release in
218       let tarball = sprintf "%s.tar.gz" package_version in
219       let urlpath =
220         if is_stable then
221           sprintf "download/%d.%d-stable/%s" major minor tarball
222         else
223           sprintf "download/%d.%d-development/%s" major minor tarball in
224       let url = "http://libguestfs.org/" ^ urlpath in
225       { version = version;
226         major = major; minor = minor; release = release;
227         is_stable = is_stable;
228         branch = branch;
229         package_version = package_version;
230         tarball = tarball;
231         urlpath = urlpath;
232         url = url }
233   )
234
235 (* Helper function to read the latest version in a repo and return
236  * the version.
237  *)
238 let git_latest_version branch =
239   let v = shout "
240     cd %s/repos/%s-%s
241     git describe --tags --abbrev=0
242   " buildtmp package (quote branch) in
243   vernames v
244
245 (* Get the latest commit. *)
246 let git_latest_commit branch =
247   shout "
248     cd %s/repos/%s-%s
249     git rev-parse HEAD
250   " buildtmp package (quote branch)
251
252 (* Clone or update a repo to the latest version on a branch, by force.
253  * It is cached in name = $buildtmp/repos/<package>-<branch>
254  *)
255 let git_force url branch =
256   sh "
257     cd %s/repos
258     if [ ! -d %s-%s ]; then git clone %s %s-%s; fi
259     cd %s-%s
260     git checkout --force %s
261     git pull
262     # Copy or update gnulib
263     git submodule init
264     git submodule update
265   " buildtmp
266     package (quote branch) (quote url) package (quote branch)
267     package (quote branch)
268     (quote branch)
269
270 let () =
271   (* Add a periodic job to check for new git commits and test them. *)
272   every libguestfs_query_mins minutes ~name:"new libguestfs commit" (
273     fun () ->
274       git_force "https://github.com/libguestfs/libguestfs.git" "master";
275
276       let commit = git_latest_commit "master" in
277       require (commit_tested "master" commit);
278   );
279
280   (* Periodic job to build new tarballs. *)
281   every libguestfs_query_mins minutes ~name:"new libguestfs version" (
282     fun () ->
283       git_force "https://github.com/libguestfs/libguestfs.git" "master";
284
285       let version = git_latest_version "master" in
286       require (website_updated version)
287   )