let mk_origin () =

    (* psql service=projectb must work, e.g. on coccia.debian.org. To make
       it work elsewhere, copy
       coccia.debian.org:/etc/postgresql-common/pg_service.conf to your
       ~/.pg_service.conf and set up tunnels accordingly. *)

    let projectb = new Postgresql.connection ~conninfo:"service=projectb" () in

    let mk_wrapper_maps transform sql =
      let r = projectb#exec sql in
      assert (r#status = Postgresql.Tuples_ok);
      Array.fold_left (fun (a, b) row ->
        match row with
        | [| key_id; key |] ->
          let key = transform key
          and key_id = int_of_string key_id in (
            IntMap.add key_id key a,
            StringMap.add key key_id b
          )
        | _ -> assert false
      ) (IntMap.empty, StringMap.empty) r#get_all
    in

    let string_identity x = x in

    let mk_wrappers name (key_of_id_map, id_of_key_map) =
      ((fun x ->
        try IntMap.find x key_of_id_map
        with Not_found -> ksprintf invalid_arg "%s_of_id(%d)" name x),
       (fun x ->
         try StringMap.find x id_of_key_map
         with Not_found -> ksprintf invalid_arg "id_of_%s(%s)" name x))
    in

    let key_of_id, id_of_key = mk_wrappers "key"
      (mk_wrapper_maps String.lowercase "select key_id, key from metadata_keys")
    in

    let suite_of_id, id_of_suite = mk_wrappers "suite"
      (mk_wrapper_maps string_identity "select id, suite_name from suite")
    in

    let arch_of_id, id_of_arch = mk_wrappers "arch"
      (mk_wrapper_maps string_identity "select id, arch_string from architecture")
    in

    let relevant_binary_key_ids = List.map id_of_key relevant_binary_keys in

    let get_binaries accu arch =
      Benl_clflags.progress "Querying projectb for %s binaries in unstable..." arch;
      let sql = sprintf
        "select b.bin_id, b.key_id, b.value from bin_associations as a join (select * from binaries_metadata where key_id in (%s)) as b on b.bin_id = a.bin join (select * from binaries) as c on c.id = a.bin where a.suite = %d and c.architecture in (%d,%d)"
        (String.concat "," (List.map string_of_int relevant_binary_key_ids))
        (id_of_suite "unstable") (id_of_arch "all") (id_of_arch arch)
      in
      let r = projectb#exec sql in
      assert (r#status = Postgresql.Tuples_ok);
      let id_indexed_map = Array.fold_left (fun a row ->
        match row with
        | [| src_id; key_id; value |] ->
          let src_id = int_of_string src_id
          and key_id = int_of_string key_id in
          let old = try IntMap.find src_id a with Not_found -> [] in
          IntMap.add src_id ((key_of_id key_id, value)::old) a
        | _ -> assert false
      ) IntMap.empty r#get_all in
      let result = IntMap.fold (fun _ assoc accu ->
        let pkg = Package.of_assoc `binary assoc in
        let name = Package.Name.of_string (Package.get "package" pkg) in
        let ver = Package.get "version" pkg in
        try
          let old_pkg = PAMap.find (name, arch) accu in
          let old_ver = Package.get "version" old_pkg in
          if Benl_base.Version.compare old_ver ver < 0
          then PAMap.add (name, arch) pkg accu
          else accu
        with Not_found ->
          PAMap.add (name, arch) pkg accu
      ) id_indexed_map accu in
      Benl_clflags.progress "\n";
      result
    in

    let sources_in_testing =
      Benl_clflags.progress "Querying projectb for sources in testing...";
      let sql = sprintf
        "select (select value from source_metadata as b where key_id = %d and b.src_id = a.source) from src_associations as a where a.suite = %d"
        (id_of_key "source") (id_of_suite "testing")
      in
      let r = projectb#exec sql in
      assert (r#status = Postgresql.Tuples_ok);
      let result = Array.fold_left (fun a row ->
        match row with
        | [| source |] -> StringSet.add source a
        | _ -> assert false
      ) StringSet.empty r#get_all in
      Benl_clflags.progress "\n";
      result
    in

    let relevant_source_key_ids =
    (* beware! key "directory" does not exist in projectb and is
       handled specifically below *)

      List.map id_of_key
        (List.filter (fun x -> x <> "directory") relevant_source_keys)
    in

    let get_sources accu =
      Benl_clflags.progress "Querying projectb for sources in unstable...";
      (* get general metadata *)
      let sql = sprintf
        "select b.src_id, b.key_id, b.value from src_associations as a join (select * from source_metadata where key_id in (%s)) as b on b.src_id = a.source where a.suite = %d"
        (String.concat "," (List.map string_of_int relevant_source_key_ids))
        (id_of_suite "unstable")
      in
      let r = projectb#exec sql in
      assert (r#status = Postgresql.Tuples_ok);
      let id_indexed_map = Array.fold_left (fun a row ->
        match row with
        | [| src_id; key_id; value |] ->
          let src_id = int_of_string src_id
          and key_id = int_of_string key_id in
          let old = try IntMap.find src_id a with Not_found -> [] in
          let key = key_of_id key_id in
          (* translate "source" to "package" for consistency with
             Sources files *)

          let key = if key = "source" then "package" else key in
          IntMap.add src_id ((key, value)::old) a
        | _ -> assert false
      ) IntMap.empty r#get_all in
    (* get .dsc paths to compute directories *)
      let sql = sprintf
        "select a.source, c.filename from src_associations as a join (select * from dsc_files) as b on b.source = a.source, files as c where a.suite = %d and b.file = c.id and c.filename like '%%dsc'"
        (id_of_suite "unstable")
      in
      let r = projectb#exec sql in
      assert (r#status = Postgresql.Tuples_ok);
      let id_indexed_dscs = Array.fold_left (fun a row ->
        match row with
        | [| src_id; filename |] ->
          let src_id = int_of_string src_id in
          IntMap.add src_id filename a
        | _ -> assert false
      ) IntMap.empty r#get_all in
    (* fake directory entry by merging id_indexed_{map,dscs} *)
      let id_indexed_map = IntMap.mapi (fun src_id pkg ->
        let directory = Filename.concat "pool"
          (Filename.dirname (IntMap.find src_id id_indexed_dscs))
        in
        ("directory", directory) :: pkg
      ) id_indexed_map in
      let result = IntMap.fold (fun _ assoc accu ->
        let pkg = Package.of_assoc `source assoc in
        let sname = Package.get "package" pkg in
        let is_in_testing =
          if StringSet.mem sname sources_in_testing
          then "yes" else "no"
        in
        let pkg = Package.add "is-in-testing" is_in_testing pkg in
        let name = Package.Name.of_string sname in
        let ver = Package.get "version" pkg in
        try
          let old_pkg = M.find name accu in
          let old_ver = Package.get "version" old_pkg in
          if Benl_base.Version.compare old_ver ver < 0
          then M.add name pkg accu
          else accu
        with Not_found ->
          M.add name pkg accu
      ) id_indexed_map accu in
      Benl_clflags.progress "\n";
      result
    in

    { get_binaries = get_binaries; get_sources = get_sources }