Author: glondu-guest
Date: Wed Feb 25 00:05:41 2009
New Revision: 6257
URL: http://svn.debian.org/wsvn/?sc=1&rev=6257
Log:
Add a script to monitor transitions
Added:
trunk/tools/ocaml_transition_monitor/
trunk/tools/ocaml_transition_monitor/Makefile
trunk/tools/ocaml_transition_monitor/ocaml-status.css
trunk/tools/ocaml_transition_monitor/ocaml_transition_monitor.mll
Added: trunk/tools/ocaml_transition_monitor/Makefile
URL:
http://svn.debian.org/wsvn/trunk/tools/ocaml_transition_monitor/Makefile?rev=6257&op=file
==============================================================================
--- trunk/tools/ocaml_transition_monitor/Makefile (added)
+++ trunk/tools/ocaml_transition_monitor/Makefile Wed Feb 25 00:05:41 2009
@@ -1,0 +1,10 @@
+all: ocaml_transition_monitor.byte
+
+%.byte: %.ml
+ ocamlfind ocamlc -package ocsigen.xhtml,str -linkpkg -o $@ $<
+
+%.ml: %.mll
+ ocamllex $<
+
+clean:
+ rm -f Packages.* *.html *.cm* *.byte *~
Added: trunk/tools/ocaml_transition_monitor/ocaml-status.css
URL:
http://svn.debian.org/wsvn/trunk/tools/ocaml_transition_monitor/ocaml-status.css?rev=6257&op=file
==============================================================================
--- trunk/tools/ocaml_transition_monitor/ocaml-status.css (added)
+++ trunk/tools/ocaml_transition_monitor/ocaml-status.css Wed Feb 25 00:05:41
2009
@@ -1,0 +1,41 @@
+body {
+ font-family: sans-serif;
+}
+h1 {
+ margin: 0;
+ padding: 5px 0px 5px 150px;
+ height: 50px;
+ background: #df0451;
+ color: white;
+ margin-bottom: 1em;
+ border-bottom: 2px solid #af0031;
+ background-image:
url(http://caml.inria.fr//pub/logos/caml-inria-fr.128x58.gif);
+ background-repeat: no-repeat;
+}
+div.status {
+ text-align: center;
+}
+div.status table a {
+ text-decoration: none;
+}
+div#footer {
+ margin-top: 2em;
+ font-size: 60%;
+}
+
+.good {
+ background: LightGreen;
+}
+
+.bad {
+ background: Salmon;
+}
+
+.unknown {
+ background: Cornsilk;
+}
+
+td {
+ border-style: solid;
+ border-width: 1px;
+}
Added: trunk/tools/ocaml_transition_monitor/ocaml_transition_monitor.mll
URL:
http://svn.debian.org/wsvn/trunk/tools/ocaml_transition_monitor/ocaml_transition_monitor.mll?rev=6257&op=file
==============================================================================
--- trunk/tools/ocaml_transition_monitor/ocaml_transition_monitor.mll (added)
+++ trunk/tools/ocaml_transition_monitor/ocaml_transition_monitor.mll Wed Feb
25 00:05:41 2009
@@ -1,0 +1,242 @@
+(*
+ Copyright © 2009 Stéphane Glondu <st...@glondu.net>
+
+ 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 3 of the License, or
+ (at your option) any later version.
+
+ Dependencies: wget, bzip2, ocsigen-dev.
+*)
+
+{
+ let ocaml_version = "3.11.0"
+
+ let mirror = "http://ftp.fr.debian.org/debian";
+ let suite = "unstable"
+ let section = "main"
+
+ let architectures =
+ [ "alpha"; "amd64"; "armel"; "hppa"; "i386"; "ia64"; "mips"; "mipsel";
"powerpc"; "s390"; "sparc" ]
+
+ module S = Set.Make(String)
+ module M = Map.Make(String)
+
+ open Printf
+ open XHTML.M
+
+ type source_package = {
+ sname: string;
+ sdeps: string list;
+ sbins : string list;
+ sversion: string;
+ }
+ type binary_package = {
+ bname: string;
+ bdeps: string list;
+ bsrc: string;
+ bversion: string;
+ bnmu: int;
+ }
+
+ let headers_to_keep =
+ [ "Package"; "Binary"; "Version"; "Build-Depends"; "Depends";
"Architecture"; "Source"; "Provides" ]
+
+ type status = Unknown | Up_to_date | Outdated
+ let string_of_status = function
+ | Unknown -> "unknown"
+ | Up_to_date -> "good"
+ | Outdated -> "bad"
+
+ let skip_download = ref false
+ let quiet_mode = ref false
+
+ let progress x =
+ if !quiet_mode then ifprintf stderr x else fprintf stderr x
+}
+
+let name = ['A'-'Z' 'a'-'z' '0'-'9' '-' '.' ':' '~' '+']+
+
+rule entry accu = parse
+ | ([^':' '\n']+ as header) ":"
+ {
+ if List.mem header headers_to_keep then
+ (entry ((header, values [] lexbuf)::accu) lexbuf)
+ else
+ (skip lexbuf; entry accu lexbuf)
+ }
+ | eof | '\n' { if accu = [] then raise End_of_file else accu }
+and values accu = parse
+ | name as name { values (name::accu) lexbuf }
+ | [' ' ',' '|']+ { values accu lexbuf }
+ | '(' [^')']* ')' | "\n " | '[' [^']']* ']'
+ { values accu lexbuf }
+ | "\n " { values accu lexbuf }
+ | "\n" { accu }
+and skip = parse
+ | ([^'\n']* "\n ")* [^'\n']* "\n" { () }
+
+{
+ let get_one = function
+ | [a] -> a
+ | x -> invalid_arg (sprintf "[%s] should have exactly one element"
(String.concat ", " x))
+
+ let assoc ?default x xs =
+ try List.assoc x xs
+ with Not_found -> match default with
+ | None -> invalid_arg ("Not_found: "^x)
+ | Some y -> y
+
+ let parse_source channel =
+ let lexbuf = Lexing.from_channel channel in
+ let result = ref M.empty in
+ let rec aux () =
+ let entry = entry [] lexbuf in
+ let name = get_one (assoc "Package" entry) in
+ let entry = {
+ sname = name;
+ sdeps = assoc ~default:[] "Build-Depends" entry;
+ sbins = assoc "Binary" entry;
+ sversion = get_one (assoc "Version" entry);
+ } in
+ result := M.add name entry !result;
+ aux ()
+ in try aux () with End_of_file -> !result
+
+ let parse_binary channel =
+ let lexbuf = Lexing.from_channel channel in
+ let result = ref M.empty in
+ let rec aux () =
+ let entry = entry [] lexbuf in
+ let name = get_one (assoc "Package" entry) in
+ let entry = {
+ bname = name;
+ bdeps = (assoc ~default:[] "Depends" entry) @ (assoc ~default:[]
"Provides" entry);
+ bsrc = get_one (assoc ~default:[name] "Source" entry);
+ bversion = get_one (assoc "Version" entry);
+ bnmu = 0;
+ } in
+ result := M.add name entry !result;
+ aux ()
+ in try aux () with End_of_file -> !result
+
+ let runtime_ocaml_regexp = Str.regexp
"^ocaml\\(-base\\)?\\(-nox\\)?-\\([0-9.]+\\)$"
+ let build_ocaml_regexp = Str.regexp "^ocaml\\(-nox\\)?$"
+
+ let depends_on_ocaml x =
+ let rec aux = function
+ | [] -> None
+ | x::xs ->
+ if Str.string_match runtime_ocaml_regexp x 0 then
+ Some (Str.matched_group 3 x)
+ else aux xs
+ in aux x.bdeps
+
+ let build_depends_on_ocaml x =
+ let rec aux = function
+ | [] -> false
+ | x::xs ->
+ if Str.string_match build_ocaml_regexp x 0 then
+ true
+ else aux xs
+ in aux x.sdeps
+
+ let with_in_file file f =
+ let chan = open_in_bin file in
+ try
+ let res = f chan in
+ close_in chan; res
+ with e -> close_in chan; raise e
+
+ let with_out_file file f =
+ let chan = open_out_bin file in
+ try
+ let res = f chan in
+ close_out chan; res
+ with e -> close_out chan; raise e
+
+ let get_arch_status arch =
+ let binaries = with_in_file ("Packages."^arch) parse_binary in
+ let runtime_versions = M.fold
+ (fun k pkg accu -> match depends_on_ocaml pkg with
+ | None -> accu
+ | Some version -> M.add k (pkg, version) accu)
+ binaries M.empty in
+ let compiled_sources = M.fold
+ (fun k (pkg, version) accu ->
+ M.add pkg.bsrc (version = ocaml_version) accu)
+ runtime_versions M.empty in
+ compiled_sources
+
+ let get_sources () =
+ let sources = with_in_file "Packages.source" parse_source in
+ let sources = M.fold
+ (fun k pkg accu ->
+ if build_depends_on_ocaml pkg
+ || pkg.sname = "ocaml"
+ || pkg.sname = "dh-ocaml" then M.add k pkg accu else accu)
+ sources M.empty in
+ sources
+
+ let get_package_lists () =
+ List.for_all
+ (fun arch ->
+ let url = sprintf "%s/dists/%s/%s/binary-%s/Packages.bz2" mirror
suite section arch in
+ let cmd = sprintf "wget -q -O- '%s' | bzcat > Packages.%s" url arch in
+ progress "Downloading Packages.%s...%!" arch;
+ let r = Sys.command cmd in
+ progress "\n%!";
+ r = 0)
+ architectures
+ && (let url = sprintf "%s/dists/%s/%s/source/Sources.bz2" mirror suite
section in
+ let cmd = sprintf "wget -q -O- '%s' | bzcat > Packages.source" url in
+ progress "Downloading Packages.source...%!";
+ let r = Sys.command cmd in
+ progress "\n%!";
+ r = 0)
+
+ let main () =
+ let all_binaries = List.map get_arch_status architectures in
+ let all_sources = List.sort compare
+ (M.fold (fun k _ accu -> k::accu) (get_sources ()) [])
+ in
+ let status pkg = List.map
+ (fun x ->
+ try if M.find pkg x then Up_to_date else Outdated
+ with Not_found -> Unknown) all_binaries
+ in
+ let status = List.map (fun pkg -> (pkg, status pkg)) all_sources in
+ let all_sources = List.map
+ (fun (pkg, status) -> tr
+ (td [a ~a:[a_href (uri_of_string
("http://packages.qa.debian.org/"^pkg))] [pcdata pkg];
+ br ();
+ small [pcdata "[";
+ a ~a:[a_href (uri_of_string
("http://buildd.debian.org/~luk/status/package.php?p="^pkg))] [pcdata "buildd"];
+ pcdata "]";
+ ]])
+ (List.map (fun x -> let x = string_of_status x in td ~a:[a_class [x]]
[pcdata x]) status))
+ status
+ in
+ let summary = tablex
+ ~thead:(thead (tr (th [pcdata "Source package"]) (List.map (fun arch ->
th [pcdata arch]) architectures)) [])
+ (match all_sources with x::xs -> tbody x xs | _ -> invalid_arg "there
must be at least one package")
+ []
+ in
+ let page_title = "Monitoring OCaml transition to "^ocaml_version in
+ let html = html
+ (head (title (pcdata page_title)) [link ~a:[a_rel [`Stylesheet]; a_href
(uri_of_string "ocaml-status.css")] ()])
+ (body [h1 [pcdata page_title];
+ div ~a:[a_class ["status"]] [summary]])
+ in
+ with_out_file "ocaml_transition_monitor.html"
+ (fun chan -> output (fun s -> fprintf chan "%s%!" s) html)
+
+ let _ =
+ let speclist = [
+ "--skip-download", Arg.Set skip_download, "Skip downloading package list
files";
+ "--quiet", Arg.Set quiet_mode, "Quiet mode";
+ ] in
+ Arg.parse speclist (fun s -> raise (Arg.Bad s)) "Generates
ocaml_transition_monitor.html";
+ if not !skip_download && not (get_package_lists ()) then failwith "Error
while downloading lists!";
+ main ()
+}
_______________________________________________
Pkg-ocaml-maint-commits mailing list
Pkg-ocaml-maint-commits@lists.alioth.debian.org
http://lists.alioth.debian.org/mailman/listinfo/pkg-ocaml-maint-commits
