contrib/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 ;