Skip to content

Commit 3f64250

Browse files
art-wart-w
authored
Validate maintenance_intent (#11308)
* Validate maintenance_intent Signed-off-by: ArthurW <arthur@tarides.com> * Fix after review Signed-off-by: ArthurW <arthur@tarides.com> --------- Signed-off-by: ArthurW <arthur@tarides.com>
1 parent 346f93a commit 3f64250

File tree

5 files changed

+326
-4
lines changed

5 files changed

+326
-4
lines changed

‎doc/changes/11308.md‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
- Validate opam `maintenance_intent` (#11308, @art-w)

‎src/dune_config_file/dune_config_file.ml‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -28,7 +28,8 @@ module Dune_config = struct
2828
fields
2929
(let+ authors = field_o "authors" (repeat string)
3030
and+ maintainers = field_o "maintainers" (repeat string)
31-
and+ maintenance_intent = field_o "maintenance_intent" (repeat string)
31+
and+ maintenance_intent =
32+
field_o "maintenance_intent" Dune_lang.Package_info.decode_maintenance_intent
3233
and+ license = field_o "license" (repeat string) in
3334
{ authors; maintainers; maintenance_intent; license })
3435
;;

‎src/dune_lang/package_info.ml‎

Lines changed: 79 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -109,6 +109,84 @@ let encode_fields
109109
]
110110
;;
111111

112+
let maintenance_intent_list = [ "any"; "latest"; "none" ]
113+
114+
let rec pp_or_list () = function
115+
| [] -> ""
116+
| [ x ] -> x
117+
| [ x; y ] -> sprintf "%S or %S" x y
118+
| x :: xs -> sprintf "%S, %a" x pp_or_list xs
119+
;;
120+
121+
let valid_maintenance_intent =
122+
let open Decoder in
123+
map_validate (located string) ~f:(fun (loc, str) ->
124+
let rec parse_part i =
125+
if i >= String.length str
126+
then if i > 0 then Error "version ends with a dot" else Error "empty version"
127+
else (
128+
match str.[i] with
129+
| '(' -> parse_token (i + 1) (i + 1)
130+
| '.' -> Error "unexpected dot"
131+
| _ -> inside_part (i + 1))
132+
and inside_part i =
133+
if i >= String.length str
134+
then Ok ()
135+
else (
136+
match str.[i] with
137+
| '.' -> parse_part (i + 1)
138+
| '(' | ')' -> Error "unexpected parenthesis"
139+
| _ -> inside_part (i + 1))
140+
and parse_token start i =
141+
if i >= String.length str
142+
then Error "unclosed parenthesis"
143+
else (
144+
match str.[i] with
145+
| ')' ->
146+
let token = String.sub str ~pos:start ~len:(i - start) in
147+
if List.mem ~equal:String.equal maintenance_intent_list token
148+
then after_token (i + 1)
149+
else
150+
Error
151+
(sprintf
152+
"unknown intent %S, expected %a"
153+
token
154+
pp_or_list
155+
maintenance_intent_list)
156+
| '-' ->
157+
let token = String.sub str ~pos:start ~len:(i - start) in
158+
if String.equal token "latest"
159+
then parse_num (i + 1) (i + 1)
160+
else Error (sprintf "substraction only allowed for \"latest\", not %S" token)
161+
| _ -> parse_token start (i + 1))
162+
and parse_num start i =
163+
if i >= String.length str
164+
then Error "unclosed parenthesis"
165+
else (
166+
match str.[i] with
167+
| ')' when i > start -> after_token (i + 1)
168+
| '0' when i > start -> parse_num start (i + 1)
169+
| '0' -> parse_num (i + 1) (i + 1)
170+
| '1' .. '9' -> parse_num start (i + 1)
171+
| _ -> Error "invalid substraction")
172+
and after_token i =
173+
if i >= String.length str
174+
then Ok ()
175+
else (
176+
match str.[i] with
177+
| '.' -> parse_part (i + 1)
178+
| _ -> Error "missing dot after intent")
179+
in
180+
match parse_part 0 with
181+
| Ok () -> Ok str
182+
| Error msg -> Error (User_error.make ~loc [ Pp.text msg ]))
183+
;;
184+
185+
let decode_maintenance_intent =
186+
let open Decoder in
187+
Syntax.since Stanza.syntax (3, 18) >>> repeat valid_maintenance_intent
188+
;;
189+
112190
let decode ?since () =
113191
let open Decoder in
114192
let v default = Option.value since ~default in
@@ -132,9 +210,7 @@ let decode ?since () =
132210
field_o "bug_reports" (Syntax.since Stanza.syntax (v (1, 10)) >>> string)
133211
and+ maintainers =
134212
field_o "maintainers" (Syntax.since Stanza.syntax (v (1, 10)) >>> repeat string)
135-
and+ maintenance_intent =
136-
field_o "maintenance_intent" (Syntax.since Stanza.syntax (v (3, 18)) >>> repeat string)
137-
in
213+
and+ maintenance_intent = field_o "maintenance_intent" decode_maintenance_intent in
138214
{ source
139215
; authors
140216
; license

‎src/dune_lang/package_info.mli‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -25,6 +25,7 @@ val decode
2525
-> unit
2626
-> t Dune_sexp.Decoder.fields_parser
2727

28+
val decode_maintenance_intent : string list Dune_sexp.Decoder.t
2829
val superpose : t -> t -> t
2930

3031
val create

‎test/blackbox-tests/test-cases/opam-maintenance-intent.t‎

Lines changed: 243 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,243 @@
1+
The `x-opam-maintenance` field allows a list of strings matching version
2+
numbers, possibly using the special keywords (latest), (any) and (none):
3+
4+
$ cat >dune-project <<EOF
5+
> (lang dune 3.18)
6+
> (generate_opam_files true)
7+
> (package (name foo) (allow_empty))
8+
> (maintenance_intent
9+
> "1.2.3"
10+
> "(latest)"
11+
> "(latest-1234567890)"
12+
> "(latest-1).(none)"
13+
> "(any).(latest).(none)"
14+
> "1.(any).2.(none)"
15+
> "3.14.(latest)")
16+
> EOF
17+
$ cat dune-project
18+
(lang dune 3.18)
19+
(generate_opam_files true)
20+
(package (name foo) (allow_empty))
21+
(maintenance_intent
22+
"1.2.3"
23+
"(latest)"
24+
"(latest-1234567890)"
25+
"(latest-1).(none)"
26+
"(any).(latest).(none)"
27+
"1.(any).2.(none)"
28+
"3.14.(latest)")
29+
$ dune build foo.opam
30+
$ cat foo.opam
31+
# This file is generated by dune, edit dune-project instead
32+
opam-version: "2.0"
33+
depends: [
34+
"dune" {>= "3.18"}
35+
"odoc" {with-doc}
36+
]
37+
build: [
38+
["dune" "subst"] {dev}
39+
[
40+
"dune"
41+
"build"
42+
"-p"
43+
name
44+
"-j"
45+
jobs
46+
"@install"
47+
"@runtest" {with-test}
48+
"@doc" {with-doc}
49+
]
50+
]
51+
x-maintenance-intent: [
52+
"1.2.3"
53+
"(latest)"
54+
"(latest-1234567890)"
55+
"(latest-1).(none)"
56+
"(any).(latest).(none)"
57+
"1.(any).2.(none)"
58+
"3.14.(latest)"
59+
]
60+
61+
The following are all invalid maintenance intents:
62+
63+
$ cat >dune-project <<EOF
64+
> (lang dune 3.18)
65+
> (maintenance_intent "")
66+
> EOF
67+
$ dune build
68+
File "dune-project", line 2, characters 20-22:
69+
2 | (maintenance_intent "")
70+
^^
71+
Error: empty version
72+
[1]
73+
74+
$ cat >dune-project <<EOF
75+
> (lang dune 3.18)
76+
> (maintenance_intent "(latest")
77+
> EOF
78+
$ dune build
79+
File "dune-project", line 2, characters 20-29:
80+
2 | (maintenance_intent "(latest")
81+
^^^^^^^^^
82+
Error: unclosed parenthesis
83+
[1]
84+
85+
$ cat >dune-project <<EOF
86+
> (lang dune 3.18)
87+
> (maintenance_intent ").1")
88+
> EOF
89+
$ dune build
90+
91+
$ cat >dune-project <<EOF
92+
> (lang dune 3.18)
93+
> (maintenance_intent ".1")
94+
> EOF
95+
$ dune build
96+
File "dune-project", line 2, characters 20-24:
97+
2 | (maintenance_intent ".1")
98+
^^^^
99+
Error: unexpected dot
100+
[1]
101+
102+
$ cat >dune-project <<EOF
103+
> (lang dune 3.18)
104+
> (maintenance_intent "1.2.")
105+
> EOF
106+
$ dune build
107+
File "dune-project", line 2, characters 20-26:
108+
2 | (maintenance_intent "1.2.")
109+
^^^^^^
110+
Error: version ends with a dot
111+
[1]
112+
113+
$ cat >dune-project <<EOF
114+
> (lang dune 3.18)
115+
> (maintenance_intent "1.2(latest).3")
116+
> EOF
117+
$ dune build
118+
File "dune-project", line 2, characters 20-35:
119+
2 | (maintenance_intent "1.2(latest).3")
120+
^^^^^^^^^^^^^^^
121+
Error: unexpected parenthesis
122+
[1]
123+
124+
$ cat >dune-project <<EOF
125+
> (lang dune 3.18)
126+
> (maintenance_intent "(none-3)")
127+
> EOF
128+
$ dune build
129+
File "dune-project", line 2, characters 20-30:
130+
2 | (maintenance_intent "(none-3)")
131+
^^^^^^^^^^
132+
Error: substraction only allowed for "latest", not "none"
133+
[1]
134+
135+
$ cat >dune-project <<EOF
136+
> (lang dune 3.18)
137+
> (maintenance_intent "(any-3)")
138+
> EOF
139+
$ dune build
140+
File "dune-project", line 2, characters 20-29:
141+
2 | (maintenance_intent "(any-3)")
142+
^^^^^^^^^
143+
Error: substraction only allowed for "latest", not "any"
144+
[1]
145+
146+
$ cat >dune-project <<EOF
147+
> (lang dune 3.18)
148+
> (maintenance_intent "(latest)1")
149+
> EOF
150+
$ dune build
151+
File "dune-project", line 2, characters 20-31:
152+
2 | (maintenance_intent "(latest)1")
153+
^^^^^^^^^^^
154+
Error: missing dot after intent
155+
[1]
156+
157+
$ cat >dune-project <<EOF
158+
> (lang dune 3.18)
159+
> (maintenance_intent "(latest-)")
160+
> EOF
161+
$ dune build
162+
File "dune-project", line 2, characters 20-31:
163+
2 | (maintenance_intent "(latest-)")
164+
^^^^^^^^^^^
165+
Error: invalid substraction
166+
[1]
167+
168+
$ cat >dune-project <<EOF
169+
> (lang dune 3.18)
170+
> (maintenance_intent "(latest-0)")
171+
> EOF
172+
$ dune build
173+
File "dune-project", line 2, characters 20-32:
174+
2 | (maintenance_intent "(latest-0)")
175+
^^^^^^^^^^^^
176+
Error: invalid substraction
177+
[1]
178+
179+
$ cat >dune-project <<EOF
180+
> (lang dune 3.18)
181+
> (maintenance_intent "(latest-00)")
182+
> EOF
183+
$ dune build
184+
File "dune-project", line 2, characters 20-33:
185+
2 | (maintenance_intent "(latest-00)")
186+
^^^^^^^^^^^^^
187+
Error: invalid substraction
188+
[1]
189+
190+
$ cat >dune-project <<EOF
191+
> (lang dune 3.18)
192+
> (maintenance_intent "(latest--1)")
193+
> EOF
194+
$ dune build
195+
File "dune-project", line 2, characters 20-33:
196+
2 | (maintenance_intent "(latest--1)")
197+
^^^^^^^^^^^^^
198+
Error: invalid substraction
199+
[1]
200+
201+
$ cat >dune-project <<EOF
202+
> (lang dune 3.18)
203+
> (maintenance_intent "(latest-a)")
204+
> EOF
205+
$ dune build
206+
File "dune-project", line 2, characters 20-32:
207+
2 | (maintenance_intent "(latest-a)")
208+
^^^^^^^^^^^^
209+
Error: invalid substraction
210+
[1]
211+
212+
$ cat >dune-project <<EOF
213+
> (lang dune 3.18)
214+
> (maintenance_intent "(latest-1")
215+
> EOF
216+
$ dune build
217+
File "dune-project", line 2, characters 20-31:
218+
2 | (maintenance_intent "(latest-1")
219+
^^^^^^^^^^^
220+
Error: unclosed parenthesis
221+
[1]
222+
223+
$ cat >dune-project <<EOF
224+
> (lang dune 3.18)
225+
> (maintenance_intent "(lates)")
226+
> EOF
227+
$ dune build
228+
File "dune-project", line 2, characters 20-29:
229+
2 | (maintenance_intent "(lates)")
230+
^^^^^^^^^
231+
Error: unknown intent "lates", expected "any", "latest" or "none"
232+
[1]
233+
234+
$ cat >dune-project <<EOF
235+
> (lang dune 3.18)
236+
> (maintenance_intent "1.2" "(latest)" "err)" "3.4")
237+
> EOF
238+
$ dune build
239+
File "dune-project", line 2, characters 37-43:
240+
2 | (maintenance_intent "1.2" "(latest)" "err)" "3.4")
241+
^^^^^^
242+
Error: unexpected parenthesis
243+
[1]

0 commit comments

Comments
 (0)