extract/fedora-koji/koji.ml

   1 (* Memory info for virtual domains.
   2    (C) Copyright 2008 Richard W.M. Jones, Red Hat Inc.
   3    http://libvirt.org/
   4
   5    This program is free software; you can redistribute it and/or modify
   6    it under the terms of the GNU General Public License as published by
   7    the Free Software Foundation; either version 2 of the License, or
   8    (at your option) any later version.
   9
  10    This program is distributed in the hope that it will be useful,
  11    but WITHOUT ANY WARRANTY; without even the implied warranty of
  12    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13    GNU General Public License for more details.
  14
  15    You should have received a copy of the GNU General Public License
  16    along with this program; if not, write to the Free Software
  17    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  18 *)
  19
  20 open Printf
  21
  22 type build = {
  23   package_name : string;                (* eg. "kernel" *)
  24   version : string;                     (* eg. "2.6.25" *)
  25   release : string;                     (* eg. "1.fc8" *)
  26   build_id : int;
  27 }
  28
  29 let string_of_build { package_name = package_name;
  30                       version = version; release = release;
  31                       build_id = build_id } =
  32   sprintf "%d: %s %s %s" build_id package_name version release
  33
  34 type rpm = {
  35   rpm_id : int;                         (* RPM ID (for downloading, etc.) *)
  36   rpm_build : build;
  37   rpm_name : string;                    (* eg. "kernel" *)
  38   rpm_version : string;                 (* eg. "2.6.25" *)
  39   rpm_release : string;                 (* eg. "1.fc8" *)
  40   rpm_size : int;                       (* size in bytes of the RPM. *)
  41   rpm_arch : string;                    (* architecture *)
  42 }
  43
  44 let string_of_rpm { rpm_id = id; rpm_build = { build_id = build_id };
  45                     rpm_name = name;
  46                     rpm_version = version; rpm_release = release;
  47                     rpm_size = size; rpm_arch = arch } =
  48   sprintf "%d: (build %d) %s %s %s (%d bytes) %s"
  49     id build_id name version release size arch
  50
  51 type rpc = < call : string -> XmlRpc.value list -> XmlRpc.value >
  52
  53 let get_string_from_struct name items =
  54   match List.assoc name items with
  55   | `String str -> str
  56   | _ -> invalid_arg (name ^ ": expected string type")
  57
  58 let get_int_from_struct name items =
  59   match List.assoc name items with
  60   | `Int i -> i
  61   | _ -> invalid_arg (name ^ ": expected int type")
  62
  63 let list_builds rpc ~prefix =
  64   let builds = rpc#call "listBuilds" [
  65     `Struct [
  66       (* __starstar is some wierd Python thing which is needed for
  67        * Python optional arguments to work.
  68        *)
  69       "__starstar", `Int 1;
  70       "prefix", `String prefix;
  71     ]
  72   ] in
  73
  74   match builds with
  75   | `Array builds ->
  76       List.map (
  77         function
  78         | `Struct items ->
  79             (try
  80                let package_name = get_string_from_struct "package_name" items in
  81                let version = get_string_from_struct "version" items in
  82                let release = get_string_from_struct "release" items in
  83                let build_id = get_int_from_struct "build_id" items in
  84                { package_name = package_name;
  85                  version = version; release = release;
  86                  build_id = build_id }
  87              with
  88              | Not_found ->
  89                  prerr_endline "missing element in build structure from koji listBuilds() calls";
  90                  exit 1
  91              | Invalid_argument err ->
  92                  prerr_endline err;
  93                  exit 1
  94             )
  95         | t ->
  96             prerr_endline "unexpected type from koji listBuilds() call";
  97             prerr_endline (XmlRpc.dump t);
  98             exit 1
  99       ) builds
 100   | t ->
 101       prerr_endline "unexpected type from koji listBuilds() call:";
 102       prerr_endline (XmlRpc.dump t);
 103       exit 1
 104
 105 let list_build_rpms rpc ({ build_id = build_id } as build) =
 106   let rpms = rpc#call "listBuildRPMs" [ `Int build_id ] in
 107
 108   match rpms with
 109   | `Array rpms ->
 110       List.map (
 111         function
 112         | `Struct items ->
 113             (try
 114                let name = get_string_from_struct "name" items in
 115                let version = get_string_from_struct "version" items in
 116                let release = get_string_from_struct "release" items in
 117                let build_id' = get_int_from_struct "build_id" items in
 118                let id = get_int_from_struct "id" items in
 119                let size = get_int_from_struct "size" items in
 120                let arch = get_string_from_struct "arch" items in
 121                assert (build_id = build_id');
 122                { rpm_name = name; rpm_version = version; rpm_release = release;
 123                  rpm_build = build; rpm_id = id; rpm_size = size;
 124                  rpm_arch = arch }
 125              with
 126              | Not_found ->
 127                  prerr_endline "missing element in build structure from koji listBuildRPMs() calls";
 128                  exit 1
 129              | Invalid_argument err ->
 130                  prerr_endline err;
 131                  exit 1
 132             )
 133         | t ->
 134             prerr_endline "unexpected type from koji listBuildRPMs() call";
 135             prerr_endline (XmlRpc.dump t);
 136             exit 1
 137       ) rpms
 138   | t ->
 139       prerr_endline "unexpected type from koji listBuildRPMs() call:";
 140       prerr_endline (XmlRpc.dump t);
 141       exit 1
 142
 143 (* This gets the RPM download URL for an RPM.  I can't see a way to
 144  * get this using the Koji API, but the URLs are fairly predictable
 145  * anyway.
 146  *)
 147 let rpm_download_url { rpm_build = { package_name = build_name };
 148                        rpm_name = rpm_name;
 149                        rpm_version = version; rpm_release = release;
 150                        rpm_arch = arch } =
 151   let filename = sprintf "%s-%s-%s.%s.rpm" rpm_name version release arch in
 152   let uri = sprintf "http://koji.fedoraproject.org/packages/%s/%s/%s/%s/%s"
 153     build_name version release arch filename in
 154   uri, filename