<commit_before>(* Copyright (C) 2013, <NAME>
 * See the README file for details, or visit http://0install.net.
 *)

(** Interacting with distribution package managers. *)

open General
open Support
open Support.Common
module FeedAttr = Constants.FeedAttr
module U = Support.Utils
module Q = Support.Qdom

open Distro

let generic_distribution config =
  object
    inherit Distro.distribution config
    val check_host_python = true
    val distro_name = "fallback"
    val id_prefix = "package:fallback"
  end

let try_cleanup_distro_version_warn version package_name =
  match Versions.try_cleanup_distro_version version with
  | None -> log_warning "Can't parse distribution version '%s' for package '%s'" version package_name; None
  | Some version -> Some (Versions.parse_version version)

let iter_dir system fn path =
  match system#readdir path with
  | Problem ex when U.is_dir system path -> raise ex
  | Problem ex -> log_debug ~ex "Failed to read directory '%s'" path
  | Success items -> items |> Array.iter fn

(** A simple cache for storing key-value pairs on disk. Distributions may wish to use this to record the
    version(s) of each distribution package currently installed. *)
module Cache =
  struct
    type cache_format = Old | New
    type package_name = string
    type machine = string option
    type entry = Versions.parsed_version * machine

    type cache_data = {
      mutable mtime : float;
      mutable size : int;
      mutable rev : int;
      contents : (package_name, entry list) Hashtbl.t;
    }

    let re_colon_space = Str.regexp_string ": "

    (* Manage the cache named [cache_leaf]. Whenever [source] changes, everything in the cache is assumed to be invalid.
       Note: [format_version] doesn't make much sense. If the format changes, just use a different [cache_leaf],
       otherwise you'll be fighting with other versions of 0install.
       The [old_format] used different separator characters.
       *)
    class cache (config:General.config) (cache_leaf:string) (source:filepath) (format_version:int) (cache_format:cache_format) =
      let warned_missing = ref false in
      let re_metadata_sep = match cache_format with Old -> re_colon_space | New -> U.re_equals
      and re_key_value_sep = match cache_format with Old -> U.re_tab | New -> U.re_equals in

      object (self)
        (* The status of the cache when we loaded it. *)
        val data = { mtime = 0.0; size = -1; rev = -1; contents = Hashtbl.create 10 }

        val cache_path = Basedir.save_path config.system (config_site +/ config_prog) config.basedirs.Basedir.cache +/ cache_leaf

        (** Reload the values from disk (even if they're out-of-date). *)
        method private load_cache =
          data.mtime <- -1.0;
          data.size <- -1;
          data.rev <- -1;
          Hashtbl.clear data.contents;

          if Sys.file_exists cache_path then (
            cache_path |> config.system#with_open_in [Open_rdonly; Open_text] (fun ch ->
              let headers = ref true in
              while !headers do
                match input_line ch with
                | "" -> headers := false
                | line ->
                    (* log_info "Cache header: %s" line; *)
                    match Utils.split_pair re_metadata_sep line, cache_format with
                    | ("mtime", mtime), _ -> data.mtime <- float_of_string mtime
                    | ("size", size), _ -> data.size <- U.safe_int_of_string size
                    | ("version", rev), Old -> data.rev <- U.safe_int_of_string rev
                    | ("format", rev), New -> data.rev <- U.safe_int_of_string rev
                    | _ -> ()
              done;

              try
                while true do
                  let line = input_line ch in
                  let key, value = Utils.split_pair re_key_value_sep line in
                  let prev = try Hashtbl.find data.contents key with Not_found -> [] in
                  if value = "-" then (
                    Hashtbl.replace data.contents key prev    (* Ensure empty list is in the table *)
                  ) else (
                    let version, machine = Utils.split_pair U.re_tab value in
                    Hashtbl.replace data.contents key @@ (Versions.parse_version version, Arch.none_if_star machine) :: prev
                  )
                done
              with End_of_file -> ()
            )
          )

        (** Add some entries to the cache.
         * Warning: adding the empty list has no effect. In particular, future calls to [get] will still call [if_missing].
         * So if you want to record the fact that a package is not installed, you see need to add an entry for it (e.g. [["-"]]). *)
        method private put key values =
          try
            Hashtbl.replace data.contents key values;
            cache_path |> config.system#with_open_out [Open_append; Open_creat] ~mode:0o644 (fun ch ->
              values |> List.iter (fun (version, machine) ->
                output_string ch @@ Printf.sprintf "%s=%s\t%s" key (Versions.format_version version) (default "*" machine)
              )
            )
          with Safe_exception _ as ex -> reraise_with_context ex "... writing cache %s" cache_path

        (** Check cache is still up-to-date (i.e. that [source] hasn't changed). Clear it if not. *)
        method private ensure_valid =
          match config.system#stat source with
          | None ->
              if not !warned_missing then (
                log_warning "Package database '%s' missing!" source;
                warned_missing := true
              )
          | Some info ->
              let flush () =
                cache_path |> config.system#atomic_write [Open_wronly; Open_binary] ~mode:0o644 (fun ch ->
                  let mtime = Int64.of_float info.Unix.st_mtime |> Int64.to_string in
                  begin match cache_format with
                  | Old -> Printf.fprintf ch "mtime: %s\nsize: %d\nformat: %d\n\n" mtime info.Unix.st_size format_version
                  | New -> Printf.fprintf ch "mtime=%s\nsize=%d\nformat=%d\n\n" mtime info.Unix.st_size format_version end;
                  self#regenerate_cache ch
                );
                self#load_cache in
              if data.mtime <> info.Unix.st_mtime then (
                if data.mtime <> -1.0 then
                  log_info "Modification time of %s has changed; invalidating cache" source;
                flush ()
              ) else if data.size <> info.Unix.st_size then (<commit_msg>Also cache negative distribution package query results<commit_after>(* Copyright (C) 2013, <NAME>
 * See the README file for details, or visit http://0install.net.
 *)

(** Interacting with distribution package managers. *)

open General
open Support
open Support.Common
module FeedAttr = Constants.FeedAttr
module U = Support.Utils
module Q = Support.Qdom

open Distro

let generic_distribution config =
  object
    inherit Distro.distribution config
    val check_host_python = true
    val distro_name = "fallback"
    val id_prefix = "package:fallback"
  end

let try_cleanup_distro_version_warn version package_name =
  match Versions.try_cleanup_distro_version version with
  | None -> log_warning "Can't parse distribution version '%s' for package '%s'" version package_name; None
  | Some version -> Some (Versions.parse_version version)

let iter_dir system fn path =
  match system#readdir path with
  | Problem ex when U.is_dir system path -> raise ex
  | Problem ex -> log_debug ~ex "Failed to read directory '%s'" path
  | Success items -> items |> Array.iter fn

(** A simple cache for storing key-value pairs on disk. Distributions may wish to use this to record the
    version(s) of each distribution package currently installed. *)
module Cache =
  struct
    type cache_format = Old | New
    type package_name = string
    type machine = string option
    type entry = Versions.parsed_version * machine

    type cache_data = {
      mutable mtime : float;
      mutable size : int;
      mutable rev : int;
      contents : (package_name, entry list) Hashtbl.t;
    }

    let re_colon_space = Str.regexp_string ": "

    (* Manage the cache named [cache_leaf]. Whenever [source] changes, everything in the cache is assumed to be invalid.
       Note: [format_version] doesn't make much sense. If the format changes, just use a different [cache_leaf],
       otherwise you'll be fighting with other versions of 0install.
       The [old_format] used different separator characters.
       *)
    class cache (config:General.config) (cache_leaf:string) (source:filepath) (format_version:int) (cache_format:cache_format) =
      let warned_missing = ref false in
      let re_metadata_sep = match cache_format with Old -> re_colon_space | New -> U.re_equals
      and re_key_value_sep = match cache_format with Old -> U.re_tab | New -> U.re_equals in

      object (self)
        (* The status of the cache when we loaded it. *)
        val data = { mtime = 0.0; size = -1; rev = -1; contents = Hashtbl.create 10 }

        val cache_path = Basedir.save_path config.system (config_site +/ config_prog) config.basedirs.Basedir.cache +/ cache_leaf

        (** Reload the values from disk (even if they're out-of-date). *)
        method private load_cache =
          data.mtime <- -1.0;
          data.size <- -1;
          data.rev <- -1;
          Hashtbl.clear data.contents;

          if Sys.file_exists cache_path then (
            cache_path |> config.system#with_open_in [Open_rdonly; Open_text] (fun ch ->
              let headers = ref true in
              while !headers do
                match input_line ch with
                | "" -> headers := false
                | line ->
                    (* log_info "Cache header: %s" line; *)
                    match Utils.split_pair re_metadata_sep line, cache_format with
                    | ("mtime", mtime), _ -> data.mtime <- float_of_string mtime
                    | ("size", size), _ -> data.size <- U.safe_int_of_string size
                    | ("version", rev), Old -> data.rev <- U.safe_int_of_string rev
                    | ("format", rev), New -> data.rev <- U.safe_int_of_string rev
                    | _ -> ()
              done;

              try
                while true do
                  let line = input_line ch in
                  let key, value = Utils.split_pair re_key_value_sep line in
                  let prev = try Hashtbl.find data.contents key with Not_found -> [] in
                  if value = "-" then (
                    Hashtbl.replace data.contents key prev    (* Ensure empty list is in the table *)
                  ) else (
                    let version, machine = Utils.split_pair U.re_tab value in
                    Hashtbl.replace data.contents key @@ (Versions.parse_version version, Arch.none_if_star machine) :: prev
                  )
                done
              with End_of_file -> ()
            )
          )

        (** Add some entries to the cache.
         * Warning: adding the empty list has no effect. In particular, future calls to [get] will still call [if_missing].
         * So if you want to record the fact that a package is not installed, you see need to add an entry for it (e.g. [["-"]]). *)
        method private put key values =
          try
            Hashtbl.replace data.contents key values;
            cache_path |> config.system#with_open_out [Open_append; Open_creat] ~mode:0o644 (fun ch ->
              if values = [] then (
                output_string ch @@ Printf.sprintf "%s=-" key (* Cache negative results too *)
              ) else (
                values |> List.iter (fun (version, machine) ->
                  output_string ch @@ Printf.sprintf "%s=%s\t%s" key (Versions.format_version version) (default "*" machine)
                )
              )
            )
          with Safe_exception _ as ex -> reraise_with_context ex "... writing cache %s" cache_path

        (** Check cache is still up-to-date (i.e. that [source] hasn't changed). Clear it if not. *)
        method private ensure_valid =
          match config.system#stat source with
          | None ->
              if not !warned_missing then (
                log_warning "Package database '%s' missing!" source;
                warned_missing := true
              )
          | Some info ->
              let flush () =
                cache_path |> config.system#atomic_write [Open_wronly; Open_binary] ~mode:0o644 (fun ch ->
                  let mtime = Int64.of_float info.Unix.st_mtime |> Int64.to_string in
                  begin match cache_format with
                  | Old -> Printf.fprintf ch "mtime: %s\nsize: %d\nformat: %d\n\n" mtime info.Unix.st_size format_version
                  | New -> Printf.fprintf ch "mtime=%s\nsize=%d\nformat=%d\n\n" mtime info.Unix.st_size format_version end;
                  self#regenerate_cache ch
                );
                self#load_cache in
              if data.mtime <> info.Unix.st_mtime then (
                if data.mtime <> -1.0 then
                  log_info "Modification time of %s has changed; invalidating cache" source;
                flush ()
              ) else if data.size <> info.Unix.st_size then (
{'fraction_non_alphanumeric': 0.0898716119828816, 'fraction_numerical': 0.004504842705908852, 'mean_word_length': 2.0142566191446027, 'pattern_counts': {'":': 2, '<': 25, '<?xml version=': 0, '>': 77, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5304236', 'n_tokens_mistral': 3804, 'n_tokens_neox': 3628, 'n_words': 1235}