Fixed comment.
[BearSSL] / src / codec / pemdec.t0
1 \ Copyright (c) 2016 Thomas Pornin <pornin@bolet.org>
2 \
3 \ Permission is hereby granted, free of charge, to any person obtaining
4 \ a copy of this software and associated documentation files (the
5 \ "Software"), to deal in the Software without restriction, including
6 \ without limitation the rights to use, copy, modify, merge, publish,
7 \ distribute, sublicense, and/or sell copies of the Software, and to
8 \ permit persons to whom the Software is furnished to do so, subject to
9 \ the following conditions:
10 \
11 \ The above copyright notice and this permission notice shall be
12 \ included in all copies or substantial portions of the Software.
13 \
14 \ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
15 \ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
16 \ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
17 \ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
18 \ BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
19 \ ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
20 \ CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
21 \ SOFTWARE.
22
23 preamble {
24
25 #include "inner.h"
26
27 #define CTX ((br_pem_decoder_context *)(void *)((unsigned char *)t0ctx - offsetof(br_pem_decoder_context, cpu)))
28
29 /* see bearssl_pem.h */
30 void
31 br_pem_decoder_init(br_pem_decoder_context *ctx)
32 {
33 memset(ctx, 0, sizeof *ctx);
34 ctx->cpu.dp = &ctx->dp_stack[0];
35 ctx->cpu.rp = &ctx->rp_stack[0];
36 br_pem_decoder_init_main(&ctx->cpu);
37 br_pem_decoder_run(&ctx->cpu);
38 }
39
40 /* see bearssl_pem.h */
41 size_t
42 br_pem_decoder_push(br_pem_decoder_context *ctx,
43 const void *data, size_t len)
44 {
45 if (ctx->event) {
46 return 0;
47 }
48 ctx->hbuf = data;
49 ctx->hlen = len;
50 br_pem_decoder_run(&ctx->cpu);
51 return len - ctx->hlen;
52 }
53
54 /* see bearssl_pem.h */
55 int
56 br_pem_decoder_event(br_pem_decoder_context *ctx)
57 {
58 int event;
59
60 event = ctx->event;
61 ctx->event = 0;
62 return event;
63 }
64
65 }
66
67 \ Define a word that evaluates to the address of a field within the
68 \ decoder context.
69 : addr:
70 next-word { field }
71 "addr-" field + 0 1 define-word
72 0 8191 "offsetof(br_pem_decoder_context, " field + ")" + make-CX
73 postpone literal postpone ; ;
74
75 addr: event
76 addr: name
77 addr: buf
78 addr: ptr
79
80 \ Set a byte at a specific address (offset within the context).
81 cc: set8 ( value addr -- ) {
82 size_t addr = T0_POP();
83 unsigned x = T0_POP();
84 *((unsigned char *)CTX + addr) = x;
85 }
86
87 \ Get a byte at a specific address (offset within the context).
88 cc: get8 ( addr -- value ) {
89 size_t addr = T0_POP();
90 T0_PUSH(*((unsigned char *)CTX + addr));
91 }
92
93 \ Send an event.
94 : send-event ( event -- )
95 addr-event set8 co ;
96
97 \ Low-level function to read a single byte. Returned value is the byte
98 \ (0 to 255), or -1 if there is no available data.
99 cc: read8-native ( -- x ) {
100 if (CTX->hlen > 0) {
101 T0_PUSH(*CTX->hbuf ++);
102 CTX->hlen --;
103 } else {
104 T0_PUSHi(-1);
105 }
106 }
107
108 \ Read next byte. Block until the next byte is available.
109 : read8 ( -- x )
110 begin read8-native dup 0< ifnot ret then drop co again ;
111
112 \ Read bytes until next end-of-line.
113 : skip-newline ( -- )
114 begin read8 `\n <> while repeat ;
115
116 \ Read bytes until next end-of-line; verify that they are all whitespace.
117 \ This returns -1 if they were all whitespace, 0 otherwise.
118 : skip-newline-ws ( -- bool )
119 -1 { r }
120 begin read8 dup `\n <> while ws? ifnot 0 >r then repeat
121 drop r ;
122
123 \ Normalise a byte to uppercase (ASCII only).
124 : norm-upper ( x -- x )
125 dup dup `a >= swap `z <= and if 32 - then ;
126
127 \ Read bytes and compare with the provided string. On mismatch, the
128 \ rest of the line is consumed. Matching is not case sensitive.
129 : match-string ( str -- bool )
130 begin
131 dup data-get8 norm-upper dup ifnot 2drop -1 ret then
132 read8 norm-upper dup `\n = if drop 2drop 0 ret then
133 = ifnot drop skip-newline 0 ret then
134 1+
135 again ;
136
137 \ Read bytes into the provided buffer, but no more than the provided
138 \ count. Reading stops when end-of-line is reached. Returned value
139 \ is the count of bytes written to the buffer, or 0 if the buffer size
140 \ was exceeded. All bytes are normalised to uppercase (ASCII only).
141 : read-bytes ( addr len -- len )
142 dup { orig-len }
143 swap
144 begin
145 over ifnot 2drop skip-newline 0 ret then
146 read8 dup `\n = if 2drop orig-len swap - ret then
147 dup `\r = if drop else norm-upper over set8 then
148 1+ swap 1- swap
149 again ;
150
151 \ Remove trailing dashes from the name buffer.
152 : trim-dashes ( len -- )
153 begin dup while
154 1-
155 dup addr-name + get8 `- <> if
156 addr-name + 1+ 0 swap set8 ret
157 then
158 repeat
159 addr-name set8 ;
160
161 \ Scan input for next "begin" banner.
162 : next-banner-begin ( -- )
163 begin
164 "-----BEGIN " match-string if
165 addr-name 127 read-bytes
166 dup if trim-dashes ret then
167 drop
168 then
169 again ;
170
171 \ Convert a Base64 character to its numerical value. Returned value is
172 \ 0 to 63 for Base64 characters, -1 for '=', and -2 for all other characters.
173 cc: from-base64 ( char -- x ) {
174 uint32_t c = T0_POP();
175 uint32_t p, q, r, z;
176 p = c - 0x41;
177 q = c - 0x61;
178 r = c - 0x30;
179
180 z = ((p + 2) & -LT(p, 26))
181 | ((q + 28) & -LT(q, 26))
182 | ((r + 54) & -LT(r, 10))
183 | (64 & -EQ(c, 0x2B))
184 | (65 & -EQ(c, 0x2F))
185 | EQ(c, 0x3D);
186 T0_PUSHi((int32_t)z - 2);
187 }
188
189 \ Test whether a character is whitespace (but not a newline).
190 : ws? ( x -- bool )
191 dup `\n <> swap 32 <= and ;
192
193 \ Read next character, skipping whitespace (except newline).
194 : next-nonws ( -- x )
195 begin
196 read8 dup ws? ifnot ret then
197 drop
198 again ;
199
200 \ Write one byte in the output buffer.
201 cc: write8 ( x -- ) {
202 unsigned char x = (unsigned char)T0_POP();
203 CTX->buf[CTX->ptr ++] = x;
204 if (CTX->ptr == sizeof CTX->buf) {
205 if (CTX->dest) {
206 CTX->dest(CTX->dest_ctx, CTX->buf, sizeof CTX->buf);
207 }
208 CTX->ptr = 0;
209 }
210 }
211
212 \ Flush the output buffer.
213 cc: flush-buf ( -- ) {
214 if (CTX->ptr > 0) {
215 if (CTX->dest) {
216 CTX->dest(CTX->dest_ctx, CTX->buf, CTX->ptr);
217 }
218 CTX->ptr = 0;
219 }
220 }
221
222 \ Decode the four next Base64 characters. Returned value is:
223 \ 0 quartet processed, three bytes produced.
224 \ -1 dash encountered as first character (no leading whitespace).
225 \ 1 quartet processed, one or two bytes produced, terminator reached.
226 \ 2 end-of-line reached.
227 \ 3 error.
228 \ For all positive return values, the remaining of the current line has been
229 \ consumed.
230 : decode-next-quartet ( -- r )
231 \ Process first character. It may be a dash.
232 read8 dup `- = if drop -1 ret then
233 dup ws? if drop next-nonws then
234 dup `\n = if drop 2 ret then
235 from-base64 dup 0< if drop skip-newline 3 ret then
236 { acc }
237
238 \ Second character.
239 next-nonws dup `\n = if drop 3 ret then
240 from-base64 dup 0< if drop skip-newline 3 ret then
241 acc 6 << + >acc
242
243 \ Third character: may be an equal sign.
244 next-nonws dup `\n = if drop 3 ret then
245 dup `= = if
246 \ Fourth character must be an equal sign.
247 drop
248 next-nonws dup `\n = if drop 3 ret then
249 skip-newline-ws ifnot drop 3 ret then
250 `= <> if 3 ret then
251 acc 0x0F and if 3 ret then
252 acc 4 >> write8
253 1 ret
254 then
255 from-base64 dup 0< if drop skip-newline 3 ret then
256 acc 6 << + >acc
257
258 \ Fourth character: may be an equal sign.
259 next-nonws dup `\n = if drop 3 ret then
260 dup `= = if
261 drop skip-newline-ws ifnot 3 ret then
262 acc 0x03 and if 3 ret then
263 acc 10 >> write8
264 acc 2 >> write8
265 1 ret
266 then
267 from-base64 dup 0< if drop skip-newline 3 ret then
268 acc 6 << + >acc
269 acc 16 >> write8
270 acc 8 >> write8
271 acc write8
272 0 ;
273
274 \ Check trailer line (possibly, the leading dash has been read). This
275 \ sends the appropriate event.
276 : check-trailer ( bool -- )
277 ifnot
278 begin read8 dup `\n = while drop repeat
279 `- <> if skip-newline 3 send-event ret then
280 then
281 "----END " match-string ifnot 3 send-event ret then
282 flush-buf
283 skip-newline 2 send-event ;
284
285 \ Decode one line worth of characters. Returned value is 0 if the end of the
286 \ object is reached, -1 otherwise. The end of object or error event is sent.
287 : decode-line ( -- bool )
288 -1 { first }
289 begin
290 decode-next-quartet
291 case
292 0 of endof
293 -1 of
294 first ifnot
295 skip-newline 3 send-event
296 else
297 -1 check-trailer
298 then
299 0 ret
300 endof
301 1 of 0 check-trailer 0 ret endof
302 2 of -1 ret endof
303
304 \ On decoding error
305 drop 3 send-event 0 ret
306 endcase
307 0 >first
308 again ;
309
310 : main ( -- ! )
311 begin
312 next-banner-begin 1 send-event
313 begin decode-line while repeat
314 again ;