201 lines
5.5 KiB
Plaintext
201 lines
5.5 KiB
Plaintext
|
(*
|
||
|
Module: Reprepro_Uploaders
|
||
|
Parses reprepro's uploaders files
|
||
|
|
||
|
Author: Raphael Pinson <raphink@gmail.com>
|
||
|
|
||
|
About: Reference
|
||
|
This lens tries to keep as close as possible to `man 1 reprepro` where possible.
|
||
|
|
||
|
About: License
|
||
|
This file is licenced under the LGPL v2+, like the rest of Augeas.
|
||
|
About: Lens Usage
|
||
|
See <lns>.
|
||
|
|
||
|
About: Configuration files
|
||
|
This lens applies to reprepro's uploaders files.
|
||
|
|
||
|
About: Examples
|
||
|
The <Test_Reprepro_Uploaders> file contains various examples and tests.
|
||
|
*)
|
||
|
|
||
|
module Reprepro_Uploaders =
|
||
|
|
||
|
(* View: logic_construct_condition
|
||
|
A logical construction for <condition> and <condition_list> *)
|
||
|
let logic_construct_condition (kw:string) (lns:lens) =
|
||
|
[ label kw . lns ]
|
||
|
. [ Sep.space . key kw . Sep.space . lns ]*
|
||
|
|
||
|
(* View: logic_construct_field
|
||
|
A generic definition for <condition_field> *)
|
||
|
let logic_construct_field (kw:string) (sep:string) (lns:lens) =
|
||
|
[ label kw . lns ]
|
||
|
. [ Build.xchgs sep kw . lns ]*
|
||
|
|
||
|
(* View: condition_re
|
||
|
A condition can be of several types:
|
||
|
|
||
|
- source
|
||
|
- byhand
|
||
|
- sections
|
||
|
- sections contain
|
||
|
- binaries
|
||
|
- binaries contain
|
||
|
- architectures
|
||
|
- architectures contain
|
||
|
|
||
|
While the lens technically also accepts "source contain"
|
||
|
and "byhand contain", these are not understood by reprepro.
|
||
|
|
||
|
The "contain" types are built by adding a "contain" subnode.
|
||
|
See the <condition_field> definition.
|
||
|
|
||
|
*)
|
||
|
let condition_re =
|
||
|
"source"
|
||
|
| "byhand"
|
||
|
| "sections"
|
||
|
| "binaries"
|
||
|
| "architectures"
|
||
|
| "distribution"
|
||
|
|
||
|
(* View: condition_field
|
||
|
A single condition field is an 'or' node.
|
||
|
It may contain several values, listed in 'or' subnodes:
|
||
|
|
||
|
> $reprepro/allow[1]/and/or = "architectures"
|
||
|
> $reprepro/allow[1]/and/or/or[1] = "i386"
|
||
|
> $reprepro/allow[1]/and/or/or[2] = "amd64"
|
||
|
> $reprepro/allow[1]/and/or/or[3] = "all"
|
||
|
|
||
|
*)
|
||
|
let condition_field =
|
||
|
let sto_condition = Util.del_str "'" . store /[^'\n]+/ . Util.del_str "'" in
|
||
|
[ key "not" . Sep.space ]? .
|
||
|
store condition_re
|
||
|
. [ Sep.space . key "contain" ]?
|
||
|
. Sep.space
|
||
|
. logic_construct_field "or" "|" sto_condition
|
||
|
|
||
|
(* View: condition
|
||
|
A condition is an 'and' node,
|
||
|
representing a union of <condition_fields>,
|
||
|
listed under 'or' subnodes:
|
||
|
|
||
|
> $reprepro/allow[1]/and
|
||
|
> $reprepro/allow[1]/and/or = "architectures"
|
||
|
> $reprepro/allow[1]/and/or/or[1] = "i386"
|
||
|
> $reprepro/allow[1]/and/or/or[2] = "amd64"
|
||
|
> $reprepro/allow[1]/and/or/or[3] = "all"
|
||
|
|
||
|
*)
|
||
|
let condition =
|
||
|
logic_construct_condition "or" condition_field
|
||
|
|
||
|
(* View: condition_list
|
||
|
A list of <conditions>, inspired by Debctrl.dependency_list
|
||
|
An upload condition list is either the wildcard '*', stored verbatim,
|
||
|
or an intersection of conditions listed under 'and' subnodes:
|
||
|
|
||
|
> $reprepro/allow[1]/and[1]
|
||
|
> $reprepro/allow[1]/and[1]/or = "architectures"
|
||
|
> $reprepro/allow[1]/and[1]/or/or[1] = "i386"
|
||
|
> $reprepro/allow[1]/and[1]/or/or[2] = "amd64"
|
||
|
> $reprepro/allow[1]/and[1]/or/or[3] = "all"
|
||
|
> $reprepro/allow[1]/and[2]
|
||
|
> $reprepro/allow[1]/and[2]/or = "sections"
|
||
|
> $reprepro/allow[1]/and[2]/or/contain
|
||
|
> $reprepro/allow[1]/and[2]/or/or = "main"
|
||
|
|
||
|
*)
|
||
|
let condition_list =
|
||
|
store "*"
|
||
|
| logic_construct_condition "and" condition
|
||
|
|
||
|
(* View: by_key
|
||
|
When a key is used to authenticate packages,
|
||
|
the value can either be a key ID or "any":
|
||
|
|
||
|
> $reprepro/allow[1]/by/key = "ABCD1234"
|
||
|
> $reprepro/allow[2]/by/key = "any"
|
||
|
|
||
|
*)
|
||
|
let by_key =
|
||
|
let any_key = [ store "any" . Sep.space
|
||
|
. key "key" ] in
|
||
|
let named_key = [ key "key" . Sep.space
|
||
|
. store (Rx.word - "any") ] in
|
||
|
value "key" . (any_key | named_key)
|
||
|
|
||
|
(* View: by_group
|
||
|
Authenticate packages by a groupname.
|
||
|
|
||
|
> $reprepro/allow[1]/by/group = "groupname"
|
||
|
|
||
|
*)
|
||
|
let by_group = value "group"
|
||
|
. [ key "group" . Sep.space
|
||
|
. store Rx.word ]
|
||
|
|
||
|
(* View: by
|
||
|
<by> statements define who is allowed to upload.
|
||
|
It can be simple keywords, like "anybody" or "unsigned",
|
||
|
or a key ID, in which case a "key" subnode is added:
|
||
|
|
||
|
> $reprepro/allow[1]/by/key = "ABCD1234"
|
||
|
> $reprepro/allow[2]/by/key = "any"
|
||
|
> $reprepro/allow[3]/by = "anybody"
|
||
|
> $reprepro/allow[4]/by = "unsigned"
|
||
|
|
||
|
*)
|
||
|
let by =
|
||
|
[ key "by" . Sep.space
|
||
|
. ( store ("anybody"|"unsigned")
|
||
|
| by_key | by_group ) ]
|
||
|
|
||
|
(* View: allow
|
||
|
An allow entry, e.g.:
|
||
|
|
||
|
> $reprepro/allow[1]
|
||
|
> $reprepro/allow[1]/and[1]
|
||
|
> $reprepro/allow[1]/and[1]/or = "architectures"
|
||
|
> $reprepro/allow[1]/and[1]/or/or[1] = "i386"
|
||
|
> $reprepro/allow[1]/and[1]/or/or[2] = "amd64"
|
||
|
> $reprepro/allow[1]/and[1]/or/or[3] = "all"
|
||
|
> $reprepro/allow[1]/and[2]
|
||
|
> $reprepro/allow[1]/and[2]/or = "sections"
|
||
|
> $reprepro/allow[1]/and[2]/or/contain
|
||
|
> $reprepro/allow[1]/and[2]/or/or = "main"
|
||
|
> $reprepro/allow[1]/by = "key"
|
||
|
> $reprepro/allow[1]/by/key = "ABCD1234"
|
||
|
|
||
|
*)
|
||
|
let allow =
|
||
|
[ key "allow" . Sep.space
|
||
|
. condition_list . Sep.space
|
||
|
. by . Util.eol ]
|
||
|
|
||
|
(* View: group
|
||
|
A group declaration *)
|
||
|
let group =
|
||
|
let add = [ key "add" . Sep.space
|
||
|
. store Rx.word ]
|
||
|
in let contains = [ key "contains" . Sep.space
|
||
|
. store Rx.word ]
|
||
|
in let empty = [ key "empty" ]
|
||
|
in let unused = [ key "unused" ]
|
||
|
in [ key "group" . Sep.space
|
||
|
. store Rx.word . Sep.space
|
||
|
. (add | contains | empty | unused) . Util.eol ]
|
||
|
|
||
|
(* View: entry
|
||
|
An entry is either an <allow> statement
|
||
|
or a <group> definition.
|
||
|
*)
|
||
|
let entry = allow | group
|
||
|
|
||
|
(* View: lns
|
||
|
The lens is made of <Util.empty>, <Util.comment> and <entry> lines *)
|
||
|
let lns = (Util.empty|Util.comment|entry)*
|