\ Copyright (c) 2016 Thomas Pornin \ \ Permission is hereby granted, free of charge, to any person obtaining \ a copy of this software and associated documentation files (the \ "Software"), to deal in the Software without restriction, including \ without limitation the rights to use, copy, modify, merge, publish, \ distribute, sublicense, and/or sell copies of the Software, and to \ permit persons to whom the Software is furnished to do so, subject to \ the following conditions: \ \ The above copyright notice and this permission notice shall be \ included in all copies or substantial portions of the Software. \ \ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, \ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF \ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND \ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS \ BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN \ ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN \ CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE \ SOFTWARE. preamble { #include "inner.h" #define CTX ((br_pem_decoder_context *)((unsigned char *)t0ctx - offsetof(br_pem_decoder_context, cpu))) /* see bearssl_pem.h */ void br_pem_decoder_init(br_pem_decoder_context *ctx) { memset(ctx, 0, sizeof *ctx); ctx->cpu.dp = &ctx->dp_stack[0]; ctx->cpu.rp = &ctx->rp_stack[0]; br_pem_decoder_init_main(&ctx->cpu); br_pem_decoder_run(&ctx->cpu); } /* see bearssl_pem.h */ size_t br_pem_decoder_push(br_pem_decoder_context *ctx, const void *data, size_t len) { if (ctx->event) { return 0; } ctx->hbuf = data; ctx->hlen = len; br_pem_decoder_run(&ctx->cpu); return len - ctx->hlen; } /* see bearssl_pem.h */ int br_pem_decoder_event(br_pem_decoder_context *ctx) { int event; event = ctx->event; ctx->event = 0; return event; } } \ Define a word that evaluates to the address of a field within the \ decoder context. : addr: next-word { field } "addr-" field + 0 1 define-word 0 8191 "offsetof(br_pem_decoder_context, " field + ")" + make-CX postpone literal postpone ; ; addr: event addr: name addr: buf addr: ptr \ Set a byte at a specific address (offset within the context). cc: set8 ( value addr -- ) { size_t addr = T0_POP(); unsigned x = T0_POP(); *((unsigned char *)CTX + addr) = x; } \ Get a byte at a specific address (offset within the context). cc: get8 ( addr -- value ) { size_t addr = T0_POP(); T0_PUSH(*((unsigned char *)CTX + addr)); } \ Send an event. : send-event ( event -- ) addr-event set8 co ; \ Low-level function to read a single byte. Returned value is the byte \ (0 to 255), or -1 if there is no available data. cc: read8-native ( -- x ) { if (CTX->hlen > 0) { T0_PUSH(*CTX->hbuf ++); CTX->hlen --; } else { T0_PUSHi(-1); } } \ Read next byte. Block until the next byte is available. : read8 ( -- x ) begin read8-native dup 0< ifnot ret then drop co again ; \ Read bytes until next end-of-line. : skip-newline ( -- ) begin read8 `\n <> while repeat ; \ Read bytes until next end-of-line; verify that they are all whitespace. \ This returns -1 if they were all whitespace, 0 otherwise. : skip-newline-ws ( -- bool ) -1 { r } begin read8 dup `\n <> while ws? ifnot 0 >r then repeat drop r ; \ Normalise a byte to uppercase (ASCII only). : norm-upper ( x -- x ) dup dup `a >= swap `z <= and if 32 - then ; \ Read bytes and compare with the provided string. On mismatch, the \ rest of the line is consumed. Matching is not case sensitive. : match-string ( str -- bool ) begin dup data-get8 norm-upper dup ifnot 2drop -1 ret then read8 norm-upper dup `\n = if drop 2drop 0 ret then = ifnot drop skip-newline 0 ret then 1+ again ; \ Read bytes into the provided buffer, but no more than the provided \ count. Reading stops when end-of-line is reached. Returned value \ is the count of bytes written to the buffer, or 0 if the buffer size \ was exceeded. All bytes are normalised to uppercase (ASCII only). : read-bytes ( addr len -- len ) dup { orig-len } swap begin over ifnot 2drop skip-newline 0 ret then read8 dup `\n = if 2drop orig-len swap - ret then dup `\r = if drop else norm-upper over set8 then 1+ swap 1- swap again ; \ Remove trailing dashes from the name buffer. : trim-dashes ( len -- ) begin dup while 1- dup addr-name + get8 `- <> if addr-name + 1+ 0 swap set8 ret then repeat addr-name set8 ; \ Scan input for next "begin" banner. : next-banner-begin ( -- ) begin "-----BEGIN " match-string if addr-name 127 read-bytes dup if trim-dashes ret then drop then again ; \ Convert a Base64 character to its numerical value. Returned value is \ 0 to 63 for Base64 characters, -1 for '=', and -2 for all other characters. : from-base64 ( char -- x ) dup dup `A >= swap `Z <= and if 65 - ret then dup dup `a >= swap `z <= and if 71 - ret then dup dup `0 >= swap `9 <= and if 4 + ret then dup `+ = if drop 62 ret then dup `/ = if drop 63 ret then `= <> 1- ; \ Test whether a character is whitespace (but not a newline). : ws? ( x -- bool ) dup `\n <> swap 32 <= and ; \ Read next character, skipping whitespace (except newline). : next-nonws ( -- x ) begin read8 dup ws? ifnot ret then drop again ; \ Write one byte in the output buffer. cc: write8 ( x -- ) { unsigned char x = (unsigned char)T0_POP(); CTX->buf[CTX->ptr ++] = x; if (CTX->ptr == sizeof CTX->buf) { if (CTX->dest) { CTX->dest(CTX->dest_ctx, CTX->buf, sizeof CTX->buf); } CTX->ptr = 0; } } \ Flush the output buffer. cc: flush-buf ( -- ) { if (CTX->ptr > 0) { CTX->dest(CTX->dest_ctx, CTX->buf, CTX->ptr); CTX->ptr = 0; } } \ Decode the four next Base64 characters. Returned value is: \ 0 quartet processed, three bytes produced. \ -1 dash encountered as first character (no leading whitespace). \ 1 quartet processed, one or two bytes produced, terminator reached. \ 2 end-of-line reached. \ 3 error. \ For all positive return values, the remaining of the current line has been \ consumed. : decode-next-quartet ( -- r ) \ Process first character. It may be a dash. read8 dup `- = if drop -1 ret then dup ws? if drop next-nonws then dup `\n = if drop 2 ret then from-base64 dup 0< if drop skip-newline 3 ret then { acc } \ Second character. next-nonws dup `\n = if drop 3 ret then from-base64 dup 0< if drop skip-newline 3 ret then acc 6 << + >acc \ Third character: may be an equal sign. next-nonws dup `\n = if drop 3 ret then dup `= = if \ Fourth character must be an equal sign. drop next-nonws dup `\n = if drop 3 ret then skip-newline-ws ifnot drop 3 ret then `= <> if 3 ret then acc 0x0F and if 3 ret then acc 4 >> write8 1 ret then from-base64 dup 0< if drop skip-newline 3 ret then acc 6 << + >acc \ Fourth character: may be an equal sign. next-nonws dup `\n = if drop 3 ret then dup `= = if drop skip-newline-ws ifnot 3 ret then acc 0x03 and if 3 ret then acc 10 >> write8 acc 2 >> write8 1 ret then from-base64 dup 0< if drop skip-newline 3 ret then acc 6 << + >acc acc 16 >> write8 acc 8 >> write8 acc write8 0 ; \ Check trailer line (possibly, the leading dash has been read). This \ sends the appropriate event. : check-trailer ( bool -- ) ifnot begin read8 dup `\n = while drop repeat `- <> if skip-newline 3 send-event ret then then "----END " match-string ifnot 3 send-event ret then flush-buf skip-newline 2 send-event ; \ Decode one line worth of characters. Returned value is 0 if the end of the \ object is reached, -1 otherwise. The end of object or error event is sent. : decode-line ( -- bool ) -1 { first } begin decode-next-quartet case 0 of endof -1 of first ifnot skip-newline 3 send-event else -1 check-trailer then 0 ret endof 1 of 0 check-trailer 0 ret endof 2 of -1 ret endof \ On decoding error drop 3 send-event 0 ret endcase 0 >first again ; : main ( -- ! ) begin next-banner-begin 1 send-event begin decode-line while repeat again ;