lenses/reprepro_uploaders.aug

   1 (*
   2 Module: Reprepro_Uploaders
   3   Parses reprepro's uploaders files
   4
   5 Author: Raphael Pinson <raphink@gmail.com>
   6
   7 About: Reference
   8   This lens tries to keep as close as possible to `man 1 reprepro` where possible.
   9
  10 About: License
  11    This file is licenced under the LGPL v2+, like the rest of Augeas.
  12 About: Lens Usage
  13    See <lns>.
  14
  15 About: Configuration files
  16    This lens applies to reprepro's uploaders files.
  17
  18 About: Examples
  19    The <Test_Reprepro_Uploaders> file contains various examples and tests.
  20 *)
  21
  22 module Reprepro_Uploaders =
  23
  24 (* View: logic_construct_condition
  25    A logical construction for <condition> and <condition_list> *)
  26 let logic_construct_condition (kw:string) (lns:lens) =
  27     [ label kw . lns ]
  28   . [ Sep.space . key kw . Sep.space . lns ]*
  29
  30 (* View: logic_construct_field
  31    A generic definition for <condition_field> *)
  32 let logic_construct_field (kw:string) (sep:string) (lns:lens) =
  33     [ label kw . lns ]
  34   . [ Build.xchgs sep kw . lns ]*
  35
  36 (* View: condition_re
  37    A condition can be of several types:
  38
  39    - source
  40    - byhand
  41    - sections
  42    - sections contain
  43    - binaries
  44    - binaries contain
  45    - architectures
  46    - architectures contain
  47
  48    While the lens technically also accepts "source contain"
  49    and "byhand contain", these are not understood by reprepro.
  50
  51    The "contain" types are built by adding a "contain" subnode.
  52    See the <condition_field> definition.
  53
  54  *)
  55 let condition_re =
  56     "source"
  57   | "byhand"
  58   | "sections"
  59   | "binaries"
  60   | "architectures"
  61   | "distribution"
  62
  63 (* View: condition_field
  64    A single condition field is an 'or' node.
  65    It may contain several values, listed in 'or' subnodes:
  66
  67    > $reprepro/allow[1]/and/or = "architectures"
  68    > $reprepro/allow[1]/and/or/or[1] = "i386"
  69    > $reprepro/allow[1]/and/or/or[2] = "amd64"
  70    > $reprepro/allow[1]/and/or/or[3] = "all"
  71
  72  *)
  73 let condition_field =
  74   let sto_condition = Util.del_str "'" . store /[^'\n]+/ . Util.del_str "'" in
  75     [ key "not" . Sep.space ]? .
  76     store condition_re
  77   . [ Sep.space . key "contain" ]?
  78   . Sep.space
  79   . logic_construct_field "or" "|" sto_condition
  80
  81 (* View: condition
  82    A condition is an 'and' node,
  83    representing a union of <condition_fields>,
  84    listed under 'or' subnodes:
  85
  86    > $reprepro/allow[1]/and
  87    > $reprepro/allow[1]/and/or = "architectures"
  88    > $reprepro/allow[1]/and/or/or[1] = "i386"
  89    > $reprepro/allow[1]/and/or/or[2] = "amd64"
  90    > $reprepro/allow[1]/and/or/or[3] = "all"
  91
  92  *)
  93 let condition =
  94     logic_construct_condition "or" condition_field
  95
  96 (* View: condition_list
  97    A list of <conditions>, inspired by Debctrl.dependency_list
  98    An upload condition list is either the wildcard '*', stored verbatim,
  99    or an intersection of conditions listed under 'and' subnodes:
 100
 101    > $reprepro/allow[1]/and[1]
 102    > $reprepro/allow[1]/and[1]/or = "architectures"
 103    > $reprepro/allow[1]/and[1]/or/or[1] = "i386"
 104    > $reprepro/allow[1]/and[1]/or/or[2] = "amd64"
 105    > $reprepro/allow[1]/and[1]/or/or[3] = "all"
 106    > $reprepro/allow[1]/and[2]
 107    > $reprepro/allow[1]/and[2]/or = "sections"
 108    > $reprepro/allow[1]/and[2]/or/contain
 109    > $reprepro/allow[1]/and[2]/or/or = "main"
 110
 111  *)
 112 let condition_list =
 113     store "*"
 114   | logic_construct_condition "and" condition
 115
 116 (* View: by_key
 117    When a key is used to authenticate packages,
 118    the value can either be a key ID or "any":
 119
 120    > $reprepro/allow[1]/by/key = "ABCD1234"
 121    > $reprepro/allow[2]/by/key = "any"
 122
 123  *)
 124 let by_key =
 125   let any_key   = [ store "any" . Sep.space
 126                   . key "key" ] in
 127   let named_key = [ key "key" . Sep.space
 128                   . store (Rx.word - "any") ] in
 129     value "key" . (any_key | named_key)
 130
 131 (* View: by_group
 132    Authenticate packages by a groupname.
 133
 134    > $reprepro/allow[1]/by/group = "groupname"
 135
 136  *)
 137 let by_group = value "group"
 138              . [ key "group" . Sep.space
 139              . store Rx.word ]
 140
 141 (* View: by
 142    <by> statements define who is allowed to upload.
 143    It can be simple keywords, like "anybody" or "unsigned",
 144    or a key ID, in which case a "key" subnode is added:
 145
 146    > $reprepro/allow[1]/by/key = "ABCD1234"
 147    > $reprepro/allow[2]/by/key = "any"
 148    > $reprepro/allow[3]/by = "anybody"
 149    > $reprepro/allow[4]/by = "unsigned"
 150
 151  *)
 152 let by =
 153     [ key "by" . Sep.space
 154          . ( store ("anybody"|"unsigned")
 155            | by_key | by_group ) ]
 156
 157 (* View: allow
 158    An allow entry, e.g.:
 159
 160    > $reprepro/allow[1]
 161    > $reprepro/allow[1]/and[1]
 162    > $reprepro/allow[1]/and[1]/or = "architectures"
 163    > $reprepro/allow[1]/and[1]/or/or[1] = "i386"
 164    > $reprepro/allow[1]/and[1]/or/or[2] = "amd64"
 165    > $reprepro/allow[1]/and[1]/or/or[3] = "all"
 166    > $reprepro/allow[1]/and[2]
 167    > $reprepro/allow[1]/and[2]/or = "sections"
 168    > $reprepro/allow[1]/and[2]/or/contain
 169    > $reprepro/allow[1]/and[2]/or/or = "main"
 170    > $reprepro/allow[1]/by = "key"
 171    > $reprepro/allow[1]/by/key = "ABCD1234"
 172
 173  *)
 174 let allow =
 175     [ key "allow" . Sep.space
 176   . condition_list . Sep.space
 177   . by . Util.eol ]
 178
 179 (* View: group
 180    A group declaration *)
 181 let group =
 182      let add = [ key "add" . Sep.space
 183              . store Rx.word ]
 184   in let contains = [ key "contains" . Sep.space
 185                     . store Rx.word ]
 186   in let empty = [ key "empty" ]
 187   in let unused = [ key "unused" ]
 188   in [ key "group" . Sep.space
 189      . store Rx.word . Sep.space
 190      . (add | contains | empty | unused) . Util.eol ]
 191
 192 (* View: entry
 193    An entry is either an <allow> statement
 194    or a <group> definition.
 195  *)
 196 let entry = allow | group
 197
 198 (* View: lns
 199    The lens is made of <Util.empty>, <Util.comment> and <entry> lines *)
 200 let lns = (Util.empty|Util.comment|entry)*