(file) Return to autoquery.ml CVS log (file) (dir) Up to [app-camlcityd] / trunk / src / autobuild / autoquery.ml

File: [app-camlcityd] / trunk / src / autobuild / autoquery.ml (download)
Revision: 221, Sun Dec 2 21:29:18 2012 UTC (6 years, 7 months ago) by gerd
File size: 5320 byte(s)
setting cgi header

(* $Id$ *)

(* CGI helper for OASIS *)

(* Queries:

   q=list s=3.12
   q=pkg s=3.12 p=pkg-name
   q=findlib l=lib-name
 *)

open Netcgi
open Printf
open Autobuild_db

let download_prefix = 
  "http://www.ocaml-programming.de/godi-backup/"

let db_login = db_options_cgi()

exception File_not_found
  (* will force a 404 response *)


let get_source db s_param =
  (* Returns (section, platform, hostname) triple for the passed-in section
     s_param. If s_param="" a section is automatically selected.
   *)
  let get_source_stm =
    sprintf 
      "SELECT DISTINCT section,platform,hostname FROM visible \
       WHERE oasis > 0 %s ORDER BY oasis DESC"
      (if s_param <> ""
       then "AND section='" ^ Mysql.escape s_param ^ "'"
       else ""
      ) in
  let get_source_res =
    Mysql.exec db get_source_stm in
  check_status db;
  let l =
    Mysql.map get_source_res
      ~f:(fun row ->
	    (unopt row.(0), unopt row.(1), unopt row.(2))
	 ) in
  match l with
    | [] ->
	raise File_not_found
    | triple :: _ ->
	triple


let list (cgi:cgi) =
  let db = Mysql.connect db_login in
  let s_param = cgi#argument_value "s" in
  let (section, platform, hostname) = get_source db s_param in
  let get_packages_stm =
    sprintf
      "SELECT DISTINCT pkgname FROM pkg_status \
       WHERE section='%s' AND platform='%s' AND hostname='%s' \
       ORDER BY pkgname"
      (Mysql.escape section)
      (Mysql.escape platform)
      (Mysql.escape hostname) in
  let get_packages_res =
    Mysql.exec db get_packages_stm in
  check_status db;
  let packages =
    Mysql.map get_packages_res
      ~f:(fun row ->
            unopt row.(0)
         ) in
  cgi # set_header ~content_type:"text/plain" ();
  List.iter
    (fun n -> 
       cgi#out_channel#output_string (n ^ "\n")
    )
    packages


let comma_split s =
  Str.split (Str.regexp "[, ]+") s

let space_split s =
  Str.split (Str.regexp "[ ]+") s

let space_cat l =
  String.concat " " l


let pkg (cgi:cgi) =
  let db = Mysql.connect db_login in
  let s_param = cgi#argument_value "s" in
  let (section, platform, hostname) = get_source db s_param in
  let p = cgi#argument_value "p" in

  let pkg_stm =
    sprintf
      "SELECT pkgversion,deps,build_deps,distfiles, \
              findlib_provides,bin_provides \
       FROM pkg_status \
       WHERE pkgname = '%s' \
         AND section = '%s' \
         AND platform = '%s' \
         AND hostname = '%s' \
         AND status = 'S' \
       ORDER BY timestamp DESC LIMIT 1"
      (Mysql.escape p)
      (Mysql.escape section)
      (Mysql.escape platform)
      (Mysql.escape hostname)  in
  let pkg_res = Mysql.exec db pkg_stm in
  check_status db;
  let l = 
    Mysql.map 
      pkg_res
      ~f:(fun r -> 
            unopt r.(0), 
            unopt_or_empty r.(1),
            unopt_or_empty r.(2),
            unopt_or_empty r.(3),
            unopt_or_empty r.(4),
            unopt_or_empty r.(5)
         ) in
  match l with
    | [] ->
	raise File_not_found
    | [version, deps, build_deps, distfiles, findlib_prov, bin_prov] ->
	let l_distfiles = space_split distfiles in
	let l_disturls = List.map (fun f -> download_prefix ^ f) l_distfiles in
	cgi # set_header ~content_type:"text/plain" ();
	List.iter
	  (fun (n,v) ->
	     cgi # out_channel # output_string
	       (sprintf "%s: %s\n"
		  n v);
	  )
	  [ "name", p;
	    "version", version;
	    "actual_deps", (space_cat (comma_split deps));
	    "actual_build_deps", (space_cat (comma_split build_deps));
	    "distfiles", (space_cat l_distfiles);
	    "disturls", (space_cat l_disturls);
	    "findlib_provides", (space_cat (comma_split findlib_prov));
	    "bin_provides", (space_cat (comma_split bin_prov));
	  ]

    | _ ->
	assert false

let findlib (cgi:cgi) =
  let db = Mysql.connect db_login in
  let l_param = cgi#argument_value "l" in
  let stm =
    sprintf
      "SELECT fl.section,fl.platform,fl.hostname,fl.pkgname,fl.pkgversion \
       FROM findlib_lookup fl, visible v \
       WHERE fl.findlib='%s' \
       AND fl.section = v.section \
       AND fl.platform = v.platform \
       AND fl.hostname = v.hostname \
       AND v.oasis <> 0"
      (Mysql.escape l_param) in
  let res = Mysql.exec db stm in
  check_status db;
  let l = 
    Mysql.map 
      res
      ~f:(fun r -> 
            unopt r.(0), 
            unopt r.(1),
            unopt r.(2),
            unopt r.(3),
            unopt r.(4)
         ) in
  cgi # set_header ~content_type:"text/plain" ();
  List.iter
    (fun (section, platform, hostname, pkgname, pkgversion) ->
       cgi # out_channel # output_string
	 (sprintf "section=%S platform=%S hostname=%S name=%S version=%S\n"
            section platform hostname pkgname pkgversion
         )
    )
    l


let process (cgi:cgi) =
  let q = cgi#argument_value "q" in
  ( try
      match q with
	| "list" -> list cgi
	| "pkg" -> pkg cgi
        | "findlib" -> findlib cgi
	| _ -> failwith "Unknown q param"
    with
      | File_not_found ->
	  cgi # set_header
	    ~status:`Not_found ~content_type:"text/plain" ();
	  cgi # out_channel # output_string 
	    "Section or package not found\n";
  );
  cgi # out_channel # commit_work()


let () =
  let buffered _ ch = new Netchannels.buffered_trans_channel ch in
  Netcgi_cgi.run ~output_type:(`Transactional buffered) process

SVN admin
Powered by
ViewCVS 1.0-dev