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
|
(**************************************************************************)
(* Copyright © 2009-2013 Stéphane Glondu <steph@glondu.net> *)
(* *)
(* This program is free software: you can redistribute it and/or modify *)
(* it under the terms of the GNU Affero General Public License as *)
(* published by the Free Software Foundation, either version 3 of the *)
(* License, or (at your option) any later version, with the additional *)
(* exemption that compiling, linking, and/or using OpenSSL is allowed. *)
(* *)
(* This program is distributed in the hope that it will be useful, but *)
(* WITHOUT ANY WARRANTY; without even the implied warranty of *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *)
(* Affero General Public License for more details. *)
(* *)
(* You should have received a copy of the GNU Affero General Public *)
(* License along with this program. If not, see *)
(* <http://www.gnu.org/licenses/>. *)
(**************************************************************************)
open Printf
open Types
type source
type binary
type 'a t = Stanza.t
module Name = struct
type 'a t = string
let of_string x = x
let to_string x = x
end
let filter_print keep outc p =
let filter =
if keep = [] then fun _ -> true
else
let keep = List.rev_map String.lowercase_ascii keep in
fun x -> List.mem (String.lowercase_ascii x) keep
in
Stanza.pp outc (Stanza.filter filter p)
let print = filter_print []
let get = Stanza.find
let has = Stanza.mem
let add = Stanza.add
module Set = struct
module S = Set.Make (String)
type 'a t = S.t
let is_empty = S.is_empty
let empty = S.empty
let add = S.add
let remove = S.remove
let mem = S.mem
let from_list = List.fold_left (fun set elt -> add elt set) empty
let exists = S.exists
let iter = S.iter
let cardinal = S.cardinal
let elements = S.elements
let fold = S.fold
let filter = S.filter
let for_all = S.for_all
end
type _ kind = Source : source kind | Binary : binary kind
let rex = Re.Pcre.regexp "^(\\S+)(?: \\((\\S+)\\))?$"
let of_stanza (type a) (kind : a kind) x : a t =
match kind with
| Binary ->
let source, version =
try
let name = get "source" x in
let r = Re.Pcre.exec ~rex name in
let name = Re.Pcre.get_substring r 1 in
let version =
try Re.Pcre.get_substring r 2 with Not_found -> get "version" x
in
(name, version)
with Not_found -> (get "package" x, get "version" x)
in
Stanza.add "Source-Version" version
(Stanza.add "Source" source (Stanza.remove "Source" x))
| Source -> x
module Map = struct
module M = Map.Make (String)
type ('a, 'b) t = 'b M.t
let empty = M.empty
let is_empty = M.is_empty
let add = M.add
let remove = M.remove
let iter = M.iter
let find = M.find
let find_opt = M.find_opt
let mapi = M.mapi
let fold = M.fold
let bindings = M.bindings
let mem = M.mem
let update_default default f key t =
let previous = try find key t with Not_found -> default in
add key (f previous) t
end
let get_and_split =
let rex = Re.Pcre.regexp "(?:[, |]|\\([^)]+\\)|:[^, |(]+)+" in
fun field x ->
try
let deps = get field x in
Re.Pcre.split ~rex deps
with Not_found -> []
let build_depends x =
get_and_split "build-depends-indep" x
@ get_and_split "build-depends" x
@ get_and_split "build-depends-arch" x
let binaries x = get_and_split "binary" x
type dependency = {
dep_name : string;
dep_version : (comparison * string) option;
}
let split_name_and_version =
let rex =
Re.Pcre.regexp
"^\\s*(\\S+)\\s*(\\(([<>=]+)\\s*([^)]+)\\))?\\s*(\\[\\s*([^\\]]+)\\s*\\])?\\s*$"
in
fun x ->
try
let r = Re.Pcre.exec ~rex x in
let dep =
try
let cmp =
match Re.Pcre.get_substring r 3 with
| "<=" -> Le
| "<<" -> Lt
| ">=" -> Ge
| ">>" -> Gt
| "=" -> Eq
| "<" -> Lt
| ">" -> Gt
| x -> ksprintf failwith "invalid comparison operator: %s" x
in
Some (cmp, Re.Pcre.get_substring r 4)
with Not_found -> None
in
{ dep_name = Re.Pcre.get_substring r 1; dep_version = dep }
with Not_found -> ksprintf failwith "unable to parse: %s" x
let dependencies =
let rex = Re.Pcre.regexp "(?:\\s*[,|]\\s*)+" in
fun field x ->
try
let deps = get field x in
let deps = Re.Pcre.split ~rex deps in
List.map split_name_and_version deps
with Not_found -> []
|
