function string base64_decode(string inbound) !======================================================================= ! title : base64_decode.fun ! author : Neil Rieck ! created : 2001-02-11 ! refereces: http://www.faqs.org/rfcs/rfc3548.html ! http://www.faqs.org/rfcs/rfc4648.html ! ! ver who when what ! --- --- -------- ----------------------------------------------------- ! 100 NSR 20190606 1. original work (derived from BASE64_DECODE2_100.BAS) !======================================================================= option type = explicit , ! cuz tricks are for kids & size = integer quad , ! overkill? & size = real xfloat ! overkill? ! declare string buf0$ , !& buf1$ , !& junk$ , !& long i% , !& j% , !& k% , !& junk% ! !======================================================================= ! main !======================================================================= main: buf0$ = inbound ! copy passed string gosub base64_decode base64_decode = buf1$ goto fini ! adios ! !==================================================================================================== ! <<< base64 support >>> ! ! encoding notes: ! 1. each 24-bit group (3 bytes) is transmitted as four 6-bit characters ! 2. characters must be sent in multiples of 4 (padding is appended as required) ! 3. the "=" char means PAD or SPECIAL processing ! 4. A=0, B=1, C=2, etc. ! 5. examples: ! 5.1 A QQ== ! A = ascii:65 = 8-bit:01000001 24-bit:010000 01xxxx xxxxxx xxxxxx ! aaaaaa aa ! 5.2 AB QUI= ! B = ascii:66 = 8-bit:01000010 24-bit:010000 010100 0010xx xxxxxx ! aaaaaa aabbbb bbbb ! 5.3 ABC QUJD ! C = ascii:67 = 8-bit:01000011 24-bit:010000 010100 001001 000011 ! aaaaaa aabbbb bbbbcc cccccc ! 5.4 ABCD QUJDRA== ! D = ascii:68 = 8-bit:01000100 24-bit:010000 010100 001001 000011 010001 00xxxx ! aaaaaa aabbbb bbbbcc cccccc dddddd dd ! 5.5 THIS IS A TEST VEhJUyBJUyBBIFRFU1Q= ! 6. bit-mapping schematic: ! ! +--first octet--+-second octet--+--third octet--+ ! |7 6 5 4 3 2 1 0|7 6 5 4 3 2 1 0|7 6 5 4 3 2 1 0| ! +-----------+---+-------+-------+---+-----------+ ! |5 4 3 2 1 0|5 4 3 2 1 0|5 4 3 2 1 0|5 4 3 2 1 0| ! +--1.index--+--2.index--+--3.index--+--4.index--+ ! ! 7. bit-mapping example: ! M| a| n example unencoded data ! 77| 97| 110 ASCII value ! 7 6 5 4 3 2 1 0|7 6 5 4 3 2 1 0|7 6 5 4 3 2 1 0 bits (3 sets of 8) ! ---------------+---------------+--------------- ! 0 1 0 0 1 1 0 1 0 1 1 0 0 0 0 1 0 1 1 0 1 1 1 0 example bit stream ! -----------+-----------+-----------+----------- ! 5 4 3 2 1 0|5 4 3 2 1 0|5 4 3 2 1 0|5 4 3 2 1 0 bits (4 sets of 6) ! 19| 22| 5| 46 base64 value ! T| W| F| u example base64 encoded symbols !==================================================================================================== ! entry: buf0$ contains base64 encoded data ! exit: buf1$ contains the decoded data (if no errors) !==================================================================================================== ! position #2 (weight #1) --+ position #65 (weight #64) --+ ! position #1 (weight #0) -+| position #64 (weight #63) -+| declare string constant base64$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/=" ! ! note: MAP declarations with identical names are overlaid ! map(switch) long switch_long , ! one 32-bit integer & string align=0 ! to enforce alignment check map(switch) byte switch_byte(3) , ! 0->3 eight-bit bytes & string align=0 ! to enforce alignment check ! declare long pad_count% ! ! base64_decode: ! buf1$ = "" ! init junk% = mod(len(buf0$),4) ! do a sanity test ! ! Here we just exit when the length is wrong. ! Perhaps it would be better to append padding characters in order to have a best effort decode ! if junk% <> 0 then ! !~ print cr+lf+bel+"-e-error, BASE-64 line is not a multiple of 4" x !~ print "-i-debug-len:"+ str$(len(buf0$)) x !~ print "-i-debug-dat>"+ buf0$ +"<" x goto base64_decode_exit ! end if ! for i% = 1 to len(buf0$) step 4 ! scan symbols by four switch_long = 0 ! init this each pass through pad_count% = 0 ! init this each pass through for j% = 0 to 3 ! scoop up four symbols each pass thru junk$ = mid$(buf0$, i%+j%, 1) ! select a base64 symbol from buf0$ if junk$ = "=" then ! if just a padding character pad_count% = pad_count% + 1 ! then skip it (but count it) else ! else not a padding character k% = pos(base64$, junk$, 1) ! find position in string if k% = 0 then ! print "-e-oops, '"+ junk$ +"' is not a legal base64 symbol" goto base64_decode_error_exit ! exit on a lookup error else ! k% = k% - 1 ! convert position to weight end if ! !~~~ switch_long = switch_long + (k% * (64%^(3%-j%))) x k x 64^2, k x 64^1, k x 64^0 ! Here, OR is the same as PLUS switch_long = switch_long or (k% * (64%^(3%-j%))) ! k x 64^2, k x 64^1, k x 64^0 end if ! next j% ! ! ! Caveat: the next stub is ENDIAN dependant (http://en.wikipedia.org/wiki/Endian) ! 1) for little ENDIAN architectures use: 2->0 ! architecures: x86, x86-64, DEC-PDP-11, DEC-VAX, DEC-Alpha, HPE-Itanium ! 2) for big ENDIAN architectures use: 1->3 ! architecures: 32-bit SPARC V8 ! 3) many 64-bit architectures are bi-ENDIAN so desired coding here would depend upon settings by the host OS ! architecures: 64-bit SPARC V9, Itanium (IA-64) ! examples>> OpenVMS on Itanium : little ! All flavors of LINIX on Itanium : little ! Most flavours of UNIX on Itanium: little ! HP-UX on Itanium : big ! print_base64: ! %let %endian=0 ! 0=little endian %if %endian=0 %then ! LITTLE ENDIAN - ignore greatest (last) byte for k% = 2 to pad_count% step -1 ! we want "2-1-0" or "2-1" or "2" (we always skip 3) %else ! BIG ENDIAN - ignore greatest (first) byte for k% = (pad_count% + 1) to 3 ! we want "1-2-3" or "2-3" or "3" (we always skip 0) %end %if ! junk% = switch_byte(k%) ! get 8 bit data junk% = junk% + 256 if junk% < 0 ! convert unsigned to signed buf1$ = buf1$ + chr$(junk%) ! next k% ! next i% ! ! base64_decode_exit: ! return ! base64_decode_error_exit: ! buf1$ = buf0$ ! oops; better to return original data return ! !======================================================================= ! adios !======================================================================= fini: end function
Back to OpenVMS
Back to OpenVMS Demo Index
Back to Home
Neil Rieck
Waterloo, Ontario, Canada.