The unpac monorepo manager self-hosting as a monorepo using unpac
[Base64_rfc2045.decode] should always progresses
Currently [Base64_rfc2045.decode] will get stuck on many errors, this fixes it to always make forward progress and to only discard 1 character, as often the next character will allow forward progress.
authored by
Matthias Horn
and committed by
GitHub
37d28446
d86865c3
+40
-65
+40
-65
vendor/opam/base64/src/base64_rfc2045.ml
+40
-65
vendor/opam/base64/src/base64_rfc2045.ml
···
24
24
let invalid_bounds off len =
25
25
invalid_arg "Invalid bounds (off: %d, len: %d)" off len
26
26
27
-
let malformed source off pos len =
28
-
`Malformed (Bytes.sub_string source (off + pos) len)
27
+
let malformed chr =
28
+
`Malformed (String.make 1 chr)
29
29
30
30
let unsafe_byte source off pos = Bytes.unsafe_get source (off + pos)
31
31
let unsafe_blit = Bytes.unsafe_blit
···
54
54
unsafe_set_chr state.buffer 2
55
55
(unsafe_chr ((quantum lsl 6) lor code land 255)) ;
56
56
flush state
57
-
| _ -> malformed (Bytes.make 1 chr) 0 0 1
58
-
59
-
let r_crlf source off len =
60
-
(* assert (0 <= off && 0 <= len && off + len <= String.length source); *)
61
-
(* assert (len = 2); *)
62
-
match Bytes.sub_string source off len with
63
-
| "\r\n" -> `Line_break
64
-
| _ -> malformed source off 0 len
57
+
| _ -> malformed chr
65
58
66
59
type src = [`Channel of in_channel | `String of string | `Manual]
67
60
···
78
71
; mutable i_pos: int
79
72
; mutable i_len: int
80
73
; mutable s: state
81
-
; h: Bytes.t
82
-
; mutable h_len: int
83
-
; mutable h_need: int
84
74
; mutable padding: int
85
75
; mutable unsafe: bool
86
76
; mutable byte_count: int
···
127
117
if decoder.limit_count > 78 then dangerous decoder true ;
128
118
decoder.pp decoder v
129
119
130
-
[@@@warning "-32"]
131
-
132
-
let is_b64 = function
133
-
| 'A' .. 'Z' | 'a' .. 'z' | '0' .. '9' | '+' | '/' -> true
134
-
| _ -> false
135
-
136
-
let t_need decoder need =
137
-
decoder.h_len <- 0 ;
138
-
decoder.h_need <- need
139
-
140
-
let rec t_fill k decoder =
141
-
let blit decoder len =
142
-
unsafe_blit decoder.i
143
-
(decoder.i_off + decoder.i_pos)
144
-
decoder.h decoder.h_len len ;
145
-
decoder.i_pos <- decoder.i_pos + len ;
146
-
decoder.h_len <- decoder.h_len + len
147
-
in
148
-
let rem = i_rem decoder in
149
-
if rem < 0 (* end of input *) then k decoder
150
-
else
151
-
let need = decoder.h_need - decoder.h_len in
152
-
if rem < need then (
153
-
blit decoder rem ;
154
-
refill (t_fill k) decoder )
155
-
else ( blit decoder need ; k decoder )
156
-
157
120
type flush_and_malformed = [`Flush of state | `Malformed of string]
158
121
159
122
let padding {size; _} padding =
···
164
127
| 3, 1 -> true
165
128
| _ -> false
166
129
167
-
let rec t_crlf decoder =
168
-
if decoder.h_len < decoder.h_need then
169
-
ret decode_base64
170
-
(malformed decoder.h 0 0 decoder.h_len)
171
-
decoder.h_len decoder
172
-
else
173
-
ret decode_base64 (r_crlf decoder.h 0 decoder.h_len) decoder.h_len decoder
174
-
175
-
and t_flush {quantum; size; buffer} =
130
+
let t_flush {quantum; size; buffer} =
176
131
match size with
177
132
| 0 | 1 -> `Flush {quantum; size; buffer= Bytes.empty}
178
133
| 2 ->
···
186
141
unsafe_set_chr buffer 0 (unsafe_chr ((quantum lsr 8) land 255)) ;
187
142
unsafe_set_chr buffer 1 (unsafe_chr (quantum land 255)) ;
188
143
`Flush {quantum; size; buffer= Bytes.sub buffer 0 2}
189
-
| _ -> malformed buffer 0 0 3
144
+
| _ -> assert false
190
145
191
-
and t_decode_base64 chr decoder =
146
+
let rec t_decode_base64 chr decoder =
192
147
if decoder.padding = 0 then
193
148
let rec go pos = function
194
149
| `Continue state ->
···
197
152
match unsafe_byte decoder.i decoder.i_off (decoder.i_pos + pos) with
198
153
| ('A' .. 'Z' | 'a' .. 'z' | '0' .. '9' | '+' | '/') as chr -> go (succ pos) (r_repr state chr)
199
154
| '=' ->
200
-
decoder.i_pos <- decoder.i_pos + pos ;
155
+
decoder.padding <- decoder.padding + 1 ;
156
+
decoder.i_pos <- decoder.i_pos + pos + 1 ;
201
157
decoder.s <- state ;
202
-
ret decode_base64 `Padding pos decoder
158
+
ret decode_base64 `Padding (pos+1) decoder
203
159
| ' ' | '\t' ->
204
-
decoder.i_pos <- decoder.i_pos + pos ;
160
+
decoder.i_pos <- decoder.i_pos + pos + 1 ;
205
161
decoder.s <- state ;
206
-
ret decode_base64 `Wsp pos decoder
162
+
ret decode_base64 `Wsp (pos + 1) decoder
207
163
| '\r' ->
208
-
decoder.i_pos <- decoder.i_pos + pos ;
164
+
decoder.i_pos <- decoder.i_pos + pos + 1 ;
165
+
decoder.s <- state ;
166
+
decode_base64_lf_after_cr decoder
167
+
| chr ->
168
+
decoder.i_pos <- decoder.i_pos + pos + 1 ;
209
169
decoder.s <- state ;
210
-
t_need decoder 2 ;
211
-
t_fill t_crlf decoder
212
-
| chr -> malformed (Bytes.make 1 chr) 0 0 1
170
+
ret decode_base64 (malformed chr) (pos+1) decoder
213
171
) else (
214
172
decoder.i_pos <- decoder.i_pos + pos ;
215
173
decoder.byte_count <- decoder.byte_count + pos ;
174
+
decoder.limit_count <- decoder.limit_count + pos ;
216
175
decoder.s <- state ;
217
176
refill decode_base64 decoder )
218
177
| #flush_and_malformed as v ->
···
220
179
ret decode_base64 v pos decoder
221
180
in
222
181
go 1 (r_repr decoder.s chr)
223
-
else malformed (Bytes.make 1 chr) 0 0 1
182
+
else (
183
+
decoder.i_pos <- decoder.i_pos + 1 ;
184
+
ret decode_base64 (malformed chr) 1 decoder)
185
+
186
+
and decode_base64_lf_after_cr decoder =
187
+
let rem = i_rem decoder in
188
+
if rem < 0 then
189
+
ret decode_base64 (malformed '\r') 1 decoder
190
+
else if rem = 0 then refill decode_base64_lf_after_cr decoder
191
+
else
192
+
match unsafe_byte decoder.i decoder.i_off decoder.i_pos with
193
+
| '\n' ->
194
+
decoder.i_pos <- decoder.i_pos + 1 ;
195
+
ret decode_base64 `Line_break 2 decoder
196
+
| _ ->
197
+
ret decode_base64 (malformed '\r') 1 decoder
224
198
225
199
and decode_base64 decoder =
226
200
let rem = i_rem decoder in
···
242
216
| ' ' | '\t' ->
243
217
decoder.i_pos <- decoder.i_pos + 1 ;
244
218
ret decode_base64 `Wsp 1 decoder
245
-
| '\r' -> t_need decoder 2 ; t_fill t_crlf decoder
246
-
| chr -> malformed (Bytes.make 1 chr) 0 0 1
219
+
| '\r' ->
220
+
decoder.i_pos <- decoder.i_pos + 1 ;
221
+
decode_base64_lf_after_cr decoder
222
+
| chr ->
223
+
decoder.i_pos <- decoder.i_pos + 1 ;
224
+
ret decode_base64 (malformed chr) 1 decoder
247
225
248
226
let pp_base64 decoder = function
249
227
| `Line_break -> reset decoder ; decoder.k decoder
···
268
246
; i_len
269
247
; i
270
248
; s= {quantum= 0; size= 0; buffer= Bytes.create 3}
271
-
; h= Bytes.create 2
272
-
; h_len= 0
273
-
; h_need= 0
274
249
; padding= 0
275
250
; unsafe= false
276
251
; byte_count= 0