← Back to branch summary

~ubuntu-branches/ubuntu/trusty/ocamlnet/trusty

« back to all changes in this revision

Viewing changes to src/netstring/netglob_lex.mll

  • Committer: Bazaar Package Importer
  • Author(s): Stéphane Glondu
  • Date: 2011-09-02 14:12:33 UTC
  • mfrom: (18.2.3 sid)
  • Revision ID: james.westby@ubuntu.com-20110902141233-zbj0ygxb92u6gy4z
Tags: 3.4-1
http://bugs.debian.org/637147
* New upstream release
  - add a new NetcgiRequire directive to ease dependency management
    (Closes: #637147)
  - remove patches that were applied upstream:
    + Added-missing-shebang-lines-in-example-shell-scripts
    + Try-also-ocamlc-for-POSIX-threads

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/netstring/netglob_lex.mll
 
1
(* $Id: netglob_lex.mll 1514 2010-12-17 18:24:59Z gerd $ *)
 
2
 
 
3
{
 
4
  exception Bracket_Unsupported
 
5
  exception Lexing_Error
 
6
 
 
7
  type bracket_token =
 
8
      Bracket_char of char
 
9
    | Bracket_range of (char * char)
 
10
    | Bracket_code of int  (* see Netglob.reparse_bracket_expr *)
 
11
    | Bracket_end
 
12
 
 
13
  type brace_token =
 
14
      Brace_literal of string
 
15
    | Brace_comma
 
16
    | Brace_braces of brace_token list  (* inner braces *)
 
17
    | Brace_end
 
18
 
 
19
  type glob_features =
 
20
      { enable_star : bool;
 
21
        enable_qmark : bool;
 
22
        enable_brackets : bool;
 
23
        enable_braces : bool;
 
24
        enable_tilde : bool;
 
25
        enable_escape : bool;
 
26
        mutable escaped : bool;  (* after a backslash *)
 
27
      }
 
28
 
 
29
  type glob_token =
 
30
      Glob_literal of string
 
31
    | Glob_star
 
32
    | Glob_qmark
 
33
    | Glob_brackets of (bool * bracket_token list)
 
34
    | Glob_braces of brace_token list
 
35
    | Glob_tilde of string * bool (* whether there is a slash *)
 
36
    | Glob_end
 
37
 
 
38
  type exploded_char =
 
39
      C of char   (* An unescaped character *)
 
40
    | E of char   (* An escaped character *)
 
41
    | Delim of char  (* delimiter *)
 
42
 
 
43
 
 
44
 
 
45
  let rec collect_until end_token parse_fun lexbuf =
 
46
    let tok = parse_fun lexbuf in
 
47
    if tok = end_token then
 
48
      []
 
49
    else
 
50
      tok :: (collect_until end_token parse_fun lexbuf)
 
51
 
 
52
 
 
53
  let string_of_exploded l =
 
54
    String.concat "" 
 
55
      (List.map
 
56
         (function 
 
57
            | C c -> String.make 1 c
 
58
            | E c -> String.make 1 c
 
59
            | Delim _ -> ""
 
60
         )
 
61
         l
 
62
      )
 
63
 
 
64
  let have_delim l =
 
65
    List.exists (function Delim _ -> true | _ -> false) l
 
66
 
 
67
}
 
68
 
 
69
(* bracket_rest: Scans a bracket expression beginning at the second 
 
70
 * character (where ']' is always the terminating character)
 
71
 *)
 
72
 
 
73
rule bracket_rest = parse
 
74
    "[:" [^ ':' ] ":]" { raise Bracket_Unsupported }
 
75
  | "[." [^ '.' ] ".]" { raise Bracket_Unsupported }
 
76
  | "[=" [^ '=' ] "=]" { raise Bracket_Unsupported }
 
77
  | "]"                { Bracket_end }
 
78
  | [ ^ ']' ] "-" [^ ']' ]     
 
79
                       { let c0 = Lexing.lexeme_char lexbuf 0 in
 
80
                         let c1 = Lexing.lexeme_char lexbuf 2 in
 
81
                         if c0 > '\127' || c1 > '\127' then raise Lexing_Error;
 
82
                         if c0 > c1 then raise Lexing_Error;
 
83
                         Bracket_range(c0,c1)
 
84
                       }
 
85
  | eof                { raise Lexing_Error }
 
86
  | [ ^ ']' ]          { Bracket_char (Lexing.lexeme_char lexbuf 0) }
 
87
 
 
88
(* bracket_first: Scans the first token of a bracket expression
 
89
 * (after "[", "[^", or "[!").
 
90
 * Here, ']' is not recognized as terminating character.
 
91
 *)
 
92
 
 
93
and bracket_first = parse
 
94
    "[:" [^ ':' ] ":]" { raise Bracket_Unsupported }
 
95
  | "[." [^ '.' ] ".]" { raise Bracket_Unsupported }
 
96
  | "[=" [^ '=' ] "=]" { raise Bracket_Unsupported }
 
97
  | _ "-" [^ ']' ]     { let c0 = Lexing.lexeme_char lexbuf 0 in
 
98
                         let c1 = Lexing.lexeme_char lexbuf 2 in
 
99
                         if c0 > '\127' || c1 > '\127' then raise Lexing_Error;
 
100
                         if c0 > c1 then raise Lexing_Error;
 
101
                         Bracket_range(c0,c1)
 
102
                       }
 
103
  | eof                { raise Lexing_Error }
 
104
  | _                  { Bracket_char (Lexing.lexeme_char lexbuf 0) }
 
105
 
 
106
 
 
107
(* brace: Collects material within brace expressions (case: backslash
 
108
 * is escape character
 
109
 *)
 
110
 
 
111
and brace = parse
 
112
    "}"                { Brace_end }
 
113
  | ","                { Brace_comma }
 
114
  | "{"                { let l = collect_until Brace_end brace lexbuf in
 
115
                         Brace_braces l }
 
116
  | '\\' _             { Brace_literal (Lexing.lexeme lexbuf) }
 
117
  | [^ '}' ',' '\\' '{' ]  { Brace_literal (Lexing.lexeme lexbuf) }
 
118
  | eof                { raise Lexing_Error }
 
119
  | _                  { raise Lexing_Error }
 
120
 
 
121
(* brace_noescape: Used for the case that backslash is not an escape
 
122
 * character
 
123
 *)
 
124
 
 
125
and brace_noescape = parse
 
126
    "}"                { Brace_end }
 
127
  | ","                { Brace_comma }
 
128
  | "{"                { let l = collect_until Brace_end brace_noescape lexbuf in
 
129
                         Brace_braces l }
 
130
  | [^ '}' ',' '{']    { Brace_literal (Lexing.lexeme lexbuf) }
 
131
  | eof                { raise Lexing_Error }
 
132
  | _                  { raise Lexing_Error }
 
133
 
 
134
and glob_expr feat = parse
 
135
    "*"                { if feat.enable_star && not feat.escaped then 
 
136
                           Glob_star
 
137
                         else (
 
138
                           feat.escaped <- false;
 
139
                           Glob_literal "*"
 
140
                         )
 
141
                       }
 
142
  | "?"                { if feat.enable_qmark && not feat.escaped then 
 
143
                           Glob_qmark
 
144
                         else (
 
145
                           feat.escaped <- false;
 
146
                           Glob_literal "?"
 
147
                         )
 
148
                       }
 
149
  | "[" [ '!' '^' ]?   { if feat.enable_brackets && not feat.escaped then (
 
150
                           let negated = 
 
151
                             String.length(Lexing.lexeme lexbuf) > 1 in
 
152
                           let t0 = bracket_first lexbuf in
 
153
                           let l = collect_until 
 
154
                                     Bracket_end bracket_rest lexbuf in
 
155
                           Glob_brackets (negated, t0 :: l)
 
156
                         )
 
157
                         else (
 
158
                           feat.escaped <- false;
 
159
                           Glob_literal (Lexing.lexeme lexbuf)
 
160
                         )
 
161
                       }
 
162
  | "{"                { if feat.enable_braces && not feat.escaped then (
 
163
                           let p =
 
164
                             if feat.enable_escape then
 
165
                               brace
 
166
                             else
 
167
                               brace_noescape in
 
168
                           let l = collect_until Brace_end p lexbuf in
 
169
                           Glob_braces l
 
170
                         )
 
171
                         else (
 
172
                           feat.escaped <- false;
 
173
                           Glob_literal "{"
 
174
                         )
 
175
                       }
 
176
  | "~"                { if (feat.enable_tilde && not feat.escaped && 
 
177
                             Lexing.lexeme_start lexbuf = 0) then (
 
178
                           let p =
 
179
                             if feat.enable_escape then
 
180
                               generic_lex_until '/'
 
181
                             else
 
182
                               generic_lex_noescape_until '/' in
 
183
                           let l = p lexbuf in
 
184
                           let s = string_of_exploded l in
 
185
                           let slash = have_delim l in
 
186
                           Glob_tilde(s,slash)
 
187
                         ) else (
 
188
                           feat.escaped <- false;
 
189
                           Glob_literal "~"
 
190
                         )
 
191
                       }
 
192
  | "\\"               { if feat.enable_escape && not feat.escaped then (
 
193
                           feat.escaped <- true;
 
194
                           Glob_literal ""
 
195
                         )
 
196
                         else (
 
197
                           feat.escaped <- false;
 
198
                           Glob_literal "\\"
 
199
                         )
 
200
                       }
 
201
  | [ ^ '*' '?' '[' '{' '\\' '~' ]+ 
 
202
                       { feat.escaped <- false;
 
203
                         Glob_literal (Lexing.lexeme lexbuf)
 
204
                       }
 
205
  | eof                { if feat.escaped then raise Lexing_Error;
 
206
                         Glob_end
 
207
                       }
 
208
 
 
209
and generic_lex_until c = parse
 
210
    '\\' _             { let char = E (Lexing.lexeme_char lexbuf 1) in
 
211
                         char :: generic_lex_until c lexbuf }
 
212
  | _                  { let lc = Lexing.lexeme_char lexbuf 0 in
 
213
                         if c = lc then [ Delim c ] else (
 
214
                           let char = C lc in
 
215
                           char :: generic_lex_until c lexbuf
 
216
                         ) }
 
217
  | eof                { [] }
 
218
 
 
219
and generic_lex_noescape_until c = parse
 
220
  | _                  { let lc = Lexing.lexeme_char lexbuf 0 in
 
221
                         if c = lc then [ Delim c ] else (
 
222
                           let char = C lc in
 
223
                           char :: generic_lex_noescape_until c lexbuf
 
224
                         ) }
 
225
  | eof                { [] }
 
226