(* Memory info for virtual domains. (C) Copyright 2008 Richard W.M. Jones, Red Hat Inc. http://libvirt.org/ This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) open Printf type build = { package_name : string; (* eg. "kernel" *) version : string; (* eg. "2.6.25" *) release : string; (* eg. "1.fc8" *) build_id : int; } let string_of_build { package_name = package_name; version = version; release = release; build_id = build_id } = sprintf "%d: %s %s %s" build_id package_name version release type rpm = { rpm_id : int; (* RPM ID (for downloading, etc.) *) rpm_build : build; rpm_name : string; (* eg. "kernel" *) rpm_version : string; (* eg. "2.6.25" *) rpm_release : string; (* eg. "1.fc8" *) rpm_size : int; (* size in bytes of the RPM. *) rpm_arch : string; (* architecture *) } let string_of_rpm { rpm_id = id; rpm_build = { build_id = build_id }; rpm_name = name; rpm_version = version; rpm_release = release; rpm_size = size; rpm_arch = arch } = sprintf "%d: (build %d) %s %s %s (%d bytes) %s" id build_id name version release size arch type rpc = < call : string -> XmlRpc.value list -> XmlRpc.value > let get_string_from_struct name items = match List.assoc name items with | `String str -> str | _ -> invalid_arg (name ^ ": expected string type") let get_int_from_struct name items = match List.assoc name items with | `Int i -> i | _ -> invalid_arg (name ^ ": expected int type") let list_builds rpc ~prefix = let builds = rpc#call "listBuilds" [ `Struct [ (* __starstar is some wierd Python thing which is needed for * Python optional arguments to work. *) "__starstar", `Int 1; "prefix", `String prefix; ] ] in match builds with | `Array builds -> List.map ( function | `Struct items -> (try let package_name = get_string_from_struct "package_name" items in let version = get_string_from_struct "version" items in let release = get_string_from_struct "release" items in let build_id = get_int_from_struct "build_id" items in { package_name = package_name; version = version; release = release; build_id = build_id } with | Not_found -> prerr_endline "missing element in build structure from koji listBuilds() calls"; exit 1 | Invalid_argument err -> prerr_endline err; exit 1 ) | t -> prerr_endline "unexpected type from koji listBuilds() call"; prerr_endline (XmlRpc.dump t); exit 1 ) builds | t -> prerr_endline "unexpected type from koji listBuilds() call:"; prerr_endline (XmlRpc.dump t); exit 1 let list_build_rpms rpc ({ build_id = build_id } as build) = let rpms = rpc#call "listBuildRPMs" [ `Int build_id ] in match rpms with | `Array rpms -> List.map ( function | `Struct items -> (try let name = get_string_from_struct "name" items in let version = get_string_from_struct "version" items in let release = get_string_from_struct "release" items in let build_id' = get_int_from_struct "build_id" items in let id = get_int_from_struct "id" items in let size = get_int_from_struct "size" items in let arch = get_string_from_struct "arch" items in assert (build_id = build_id'); { rpm_name = name; rpm_version = version; rpm_release = release; rpm_build = build; rpm_id = id; rpm_size = size; rpm_arch = arch } with | Not_found -> prerr_endline "missing element in build structure from koji listBuildRPMs() calls"; exit 1 | Invalid_argument err -> prerr_endline err; exit 1 ) | t -> prerr_endline "unexpected type from koji listBuildRPMs() call"; prerr_endline (XmlRpc.dump t); exit 1 ) rpms | t -> prerr_endline "unexpected type from koji listBuildRPMs() call:"; prerr_endline (XmlRpc.dump t); exit 1 (* This gets the RPM download URL for an RPM. I can't see a way to * get this using the Koji API, but the URLs are fairly predictable * anyway. *) let rpm_download_url { rpm_build = { package_name = build_name }; rpm_name = rpm_name; rpm_version = version; rpm_release = release; rpm_arch = arch } = let filename = sprintf "%s-%s-%s.%s.rpm" rpm_name version release arch in let uri = sprintf "http://koji.fedoraproject.org/packages/%s/%s/%s/%s/%s" build_name version release arch filename in uri, filename