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 ;