File: control_file.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 (200 lines) | stat: -rw-r--r-- 5,336 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
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
(* approx: proxy server for Debian archive files
   Copyright (C) 2011  Eric C. Cooper <ecc@cmu.edu>
   Released under the GNU General Public License *)

open Config
open Log
open Util

type paragraph = { file : string; line : int; fields : (string * string) list }

exception Missing of paragraph * string

let defined name par = List.mem_assoc name par.fields

let lookup name par =
  try List.assoc name par.fields
  with Not_found -> raise (Missing (par, name))

let file_name par = par.file

let line_number par = par.line

let iter_fields proc par = List.iter proc par.fields

let trim_left s i =
  let n = String.length s in
  let rec loop i =
    if i < n && (s.[i] = ' ' || s.[i] = '\t') then loop (i + 1)
    else i
  in
  loop i

let trim_right s i =
  let rec loop i =
    if i > 0 && (s.[i - 1] = ' ' || s.[i - 1] = '\t') then loop (i - 1)
    else i
  in
  loop i

let trim s = substring s ~until: (trim_right s (String.length s))

let parse line =
  try
    let i = String.index line ':' in
    let name =
      String.lowercase (substring line ~until: (trim_right line i))
    in
    let info =
      substring line ~from: (trim_left line (i + 1))
    in
    name, info
  with _ -> failwith ("malformed line: " ^ line)

let next_line chan =
  try Some (trim (input_line chan))
  with End_of_file -> None

(* Check if a file is a signed control file *)

let is_signed file = Filename.basename file = "InRelease"

(* Check the initial lines of a cleartext signed message
   (as defined in RFC 4880) and return the new line number *)

let skip_initial_lines chan =
  let is_hash line = is_prefix "Hash:" line in
  let rec loop n =
    match next_line chan with
    | None -> failwith "EOF in PGP header"
    | Some "" -> n + 1
    | Some line ->
        if is_hash line then loop (n + 1)
        else failwith ("unexpected line in PGP header: " ^ line)
  in
  begin match next_line chan with (* line 1 *)
  | Some "-----BEGIN PGP SIGNED MESSAGE-----" -> ()
  | _ -> failwith "missing PGP header"
  end;
  begin match next_line chan with (* line 2 *)
  | None -> failwith "EOF in PGP header"
  | Some line ->
      if not (is_hash line) then failwith "missing Hash in PGP header"
  end;
  loop 3

let rec skip_final_lines chan =
  match next_line chan with
  | None -> ()
  | Some _ -> skip_final_lines chan

let read_paragraph file n chan =
  let rec loop lines i j =
    match next_line chan with
    | None ->
        if lines <> [] then lines, i, j + 1
        else raise End_of_file
    | Some "-----BEGIN PGP SIGNATURE-----" when is_signed file ->
        if lines <> [] then begin
          skip_final_lines chan;
          lines, i, j + 1
        end else raise End_of_file
    | Some "" ->
        if lines <> [] then lines, i, j + 1
        else loop [] (i + 1) (j + 1)
    | Some line ->
        if line.[0] = ' ' || line.[0] = '\t' then
          match lines with
          | last :: others ->
              let line =
                if line = " ." then ""
                else substring line ~from: 1
              in
              loop ((last ^ "\n" ^ line) :: others) i (j + 1)
          | [] -> failwith ("leading white space: " ^ line)
        else
          loop (line :: lines) i (j + 1)
  in
  let n = if n = 1 && is_signed file then skip_initial_lines chan else n in
  let fields, i, j = loop [] n n in
  { file = file; line = i; fields = List.rev_map parse fields }, j

let fold f init file =
  let read_file chan =
    let next n =
      try Some (read_paragraph file n chan)
      with End_of_file -> None
    in
    let rec loop x n =
      match next n with
      | Some (p, n') -> loop (f x p) n'
      | None -> x
    in
    loop init 1
  in
  with_in_channel open_file file read_file

let iter = iter_of_fold fold

let read file =
  let once prev p =
    match prev with
    | None -> Some p
    | Some _ -> failwith (file ^ " contains more than one paragraph")
  in
  match fold once None file with
  | Some p -> p
  | None -> failwith (file ^ " contains no paragraphs")

let get_checksum par =
  if defined "sha256" par then
    lookup "sha256" par, file_sha256sum
  else if defined "sha1" par then
    lookup "sha1" par, file_sha1sum
  else
    lookup "md5sum" par, file_md5sum

type info = string * int64

let info_list data =
  let lines =
    match split_lines data with
    | "" :: lines -> lines
    | lines -> lines
  in
  List.map
    (fun line ->
       Scanf.sscanf line "%s %Ld %s" (fun sum size file -> (sum, size), file))
    lines

let read_checksum_info file =
  let lines, checksum = get_checksum (read file) in
  info_list lines, checksum

let lookup_info field par = info_list (lookup field par)

type validity =
  | Valid
  | Wrong_size of int64
  | Wrong_checksum of string

let validate ?checksum (sum, size) file =
  let n = file_size file in
  if n <> size then Wrong_size n
  else
    match checksum with
    | Some file_checksum ->
        let s = file_checksum file in
        if s <> sum then Wrong_checksum s
        else Valid
    | None -> Valid

let valid checksum ((s, n) as info) file =
  match validate ~checksum info file with
  | Valid -> true
  | Wrong_size n' ->
      debug_message "%s: size %Ld should be %Ld" (shorten file) n' n;
      false
  | Wrong_checksum s' ->
      debug_message "%s: checksum %s should be %s" (shorten file) s' s;
      false