File: import.ml

package info (click to toggle)
approx 5.10-2
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, bullseye, sid
  • size: 340 kB
  • sloc: ml: 2,220; sh: 42; makefile: 32
file content (183 lines) | stat: -rw-r--r-- 5,369 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
(* approx: proxy server for Debian archive files
   Copyright (C) 2011  Eric C. Cooper <ecc@cmu.edu>
   Released under the GNU General Public License *)

(* Import local files into the approx cache *)

open Config
open Program
open Util

let usage () =
  print "Usage: approx-import [options] file ...\n\
Import local files into the approx cache\n\
Options:\n\
\    -s|--simulate   scan but do not actually import any files\n\
\    -q|--quiet      do not print the file names that are imported\n\
\    -v|--verbose    print information about each file";
  exit 1

let simulate = ref false
let quiet = ref false
let verbose = ref false
let files = ref []

let () =
  List.iter
    (function
       | "-k" | "--keep" | "-s" | "--simulate" -> simulate := true
       | "-q" | "--quiet" -> quiet := true
       | "-v" | "--verbose" -> verbose := true
       | arg ->
           if arg.[0] = '-' then usage ()
           else files := arg :: !files)
    arguments

let simulate = !simulate
let quiet = !quiet
let verbose = !verbose
let files = if !files <> [] then List.rev !files else usage ()

(* Import status of an individual file *)

type import_status =
  | Not_seen
  | Exists of string
  | Imported of string

let imported = function
  | Not_seen | Exists _ -> false
  | Imported _ -> true

let string_of_import_status = function
  | Not_seen -> "not referenced by any Packages file"
  | Exists loc -> "already cached as " ^ loc
  | Imported loc -> "imported to " ^ loc

(* Information about a package that can be extracted
   from its filename, size, and md5sum *)

type package =
  { name : string;
    epoch : string;
    version : string;
    arch : string;
    size : int64;
    file : string;
    base : string;
    md5sum : string;
    mutable status : import_status }

(* Regular expression for matching package filenames *)

let file_re = Pcre.regexp "^([^_]+)_(?:(\\d+)%3a)?([^_]+)_(.+)\\.deb$"

let package_of_file file =
  let base = Filename.basename file in
  match Pcre.extract ~rex: file_re ~full_match: false base with
  | [| name; epoch; version; arch |] ->
      { name = name;
        epoch = epoch;
        version = version;
        arch = arch;
        size = file_size file;
        file = file;
        base = base;
        md5sum = file_md5sum file;
        status = Not_seen }
  | _ -> raise Not_found

let without_epoch version =
  try substring ~from: (String.index version ':' + 1) version
  with Not_found -> version

let packages = Hashtbl.create (List.length files)

let add_package pkg =
  (try
     let q = Hashtbl.find packages pkg.md5sum in
     if pkg.name <> q.name then
       print "%s: MD5 collision with %s" pkg.base q.base
   with Not_found -> ());
  Hashtbl.replace packages pkg.md5sum pkg

let scan_files () =
  let add_file name =
    if Sys.file_exists name then begin
      try add_package (package_of_file name)
      with Not_found ->
        if verbose then print "%s: ignored" (Filename.basename name)
    end else
      print "%s: not found" name
  in
  let n = List.length files in
  if n > 1 && verbose then print "[ scanning %d files ]" n;
  List.iter add_file files;
  if Hashtbl.length packages = 0 then begin
    if not quiet then print "%s" "no .deb files specified";
    exit 1
  end

let import_package pkg dst =
  let target = cache_dir ^/ dst in
  if Sys.file_exists target then
    pkg.status <- Exists dst
  else begin
    pkg.status <- Imported dst;
    if not simulate then begin
      make_directory (Filename.dirname target);
      ignore (Sys.command (Printf.sprintf "cp -p %s %s" pkg.file target))
    end
  end

let maybe_import pkg fields dist =
  let mismatch kind =
    if verbose then
      print "%s: %s mismatch (should be %s)"
        pkg.base kind (Control_file.lookup kind fields)
  in
  if not (imported pkg.status) then
    if pkg.version = without_epoch (Control_file.lookup "version" fields) then
      if pkg.arch = Control_file.lookup "architecture" fields then
        if pkg.size = Int64.of_string (Control_file.lookup "size" fields) then
          import_package pkg (dist ^/ Control_file.lookup "filename" fields)
        else mismatch "size"
      else mismatch "architecture"
    else mismatch "version"

let index_seen = ref false

let import_files index =
  if Release.is_packages_file index then
    let dist, path = split_cache_path index in
    let check_package fields =
      try
        let md5sum = Control_file.lookup "md5sum" fields in
        maybe_import (Hashtbl.find packages md5sum) fields dist
      with Not_found -> ()
    in
    index_seen := true;
    if verbose then print "[ %s/%s ]" dist path;
    Control_file.iter check_package index

let print_package { base = base; status = status; _ } =
  if verbose || imported status then
    print "%s: %s" base (string_of_import_status status)

let print_status () =
  let pkgs = Hashtbl.fold (fun _ pkg list -> pkg :: list) packages [] in
  let cmp p q = String.compare p.base q.base in
  List.iter print_package (List.sort cmp pkgs)

let import () =
  if not simulate then drop_privileges ~user ~group;
  scan_files ();
  iter_non_dirs import_files cache_dir;
  if not !index_seen then begin
    print "%s" "There are no Packages files in the approx cache.\n\
                Please run \"apt-get update\" first.";
    exit 1
  end;
  if not quiet then print_status ()

let () = main_program import ()