Commit 4c23b853 authored by Steffen Michels's avatar Steffen Michels

Merge branch '70-in-place-base64-decoder' into 'master'

Resolve "Add in-place base64 decoder"

Closes #70

See merge request !266
parents 7f54538b 34b43562
Pipeline #28315 failed with stage
in 2 minutes and 44 seconds
......@@ -14,7 +14,7 @@ test-nightly:
image: "camilstaps/clean:nightly"
script:
- COCLPATH=./compiler make -C tests/linux64 run
- cleantest -r testproperties --options '-IL;Dynamics;-d;src/libraries/OS-Independent;-P;OutputTestEvents;-T;Tests 100000;-C;-h;-C;100m;-r' --junit junit.xml
- cleantest -r testproperties --options '-IL;Dynamics;-d;src/libraries/OS-Independent;-P;OutputTestEvents;-T;Tests 100000;-T;MaxStringLength 500;-C;-h;-C;100m;-r' --junit junit.xml
artifacts:
paths:
- junit.xml
......
definition module Text.Encodings.Base64
/*
* Base64 and Base64URL encoding/decoding according to RFC4648. More info:
* - http://tools.ietf.org/html/rfc4648
* - http://en.wikipedia.org/wiki/Base64
/**
* Base64 and Base64URL encoding/decoding according to RFC4648. More info:
* - http://tools.ietf.org/html/rfc4648
* - http://en.wikipedia.org/wiki/Base64
*
* @property-bootstrap
* import StdEnv
* import Text
*/
:: Length :== Int
......@@ -13,21 +17,33 @@ definition module Text.Encodings.Base64
/**
* Converts a String to a Base64-encoded String.
* @property inverse: A.x :: String:
* base64Decode (base64Encode x) == x
*/
base64Encode :: !.String -> .String
/**
* Converts a String to a Base64-encoded String given a maximum line length.
* @property inverse: A.len :: Int; x :: String:
* len > 0 ==> base64Decode (base64EncodeLen x len) == x
* @property max length: A.len :: Int; x :: String:
* len > 0 ==> all ((>=) len o size) (split "\n" (base64EncodeLen x len))
*/
base64EncodeLen :: !.String !Length -> .String
/**
* Converts a String to an URL-safe Base64-encoded String.
* @property inverse: A.x :: String:
* base64URLDecode (base64URLEncode x) == x
*/
base64URLEncode :: !.String -> .String
/**
* Converts a String to an URL-safe Base64-encoded String given a maximum line length.
* @property inverse: A.len :: Int; x :: String:
* len > 0 ==> base64URLDecode (base64URLEncodeLen x len) == x
* @property max length: A.len :: Int; x :: String:
* len > 0 ==> all ((>=) len o size) (split "\n" (base64URLEncodeLen x len))
*/
base64URLEncodeLen :: !.String !Length -> .String
......@@ -40,3 +56,21 @@ base64Decode :: !.String -> .String
* Converts an URL-safe Base64-encoded String to String.
*/
base64URLDecode :: !.String -> .String
/**
* Decodes a Base64-encoded String in place.
* @property inverse: A.x :: String:
* base64DecodeUnique (base64Encode x) == x
* @property inverse with linebreaks: A.len :: Int; x :: String:
* len > 0 ==> base64DecodeUnique (base64EncodeLen x len) == x
*/
base64DecodeUnique :: !*String -> .String
/**
* Decodes a URL-safe Base64-encoded String in place.
* @property inverse: A.x :: String:
* base64URLDecodeUnique (base64URLEncode x) == x
* @property inverse with linebreaks: A.len :: Int; x :: String:
* len > 0 ==> base64URLDecodeUnique (base64URLEncodeLen x len) == x
*/
base64URLDecodeUnique :: !*String -> .String
......@@ -59,93 +59,129 @@ encodeString s a
| otherwise = encodeLastOctet (oct >> 6) (off - 1) p {s & [off + dest_o] = a.[oct bitand 63]}
srcSize = size s
addLineBreaks :: !.String Length -> .String
addLineBreaks :: !u:String !Length -> u:String
addLineBreaks s l
| l > 0 = addLineBreaks` s "" l
| otherwise = abort "Length cannot be 0 or less."
| l <= 0
= abort "Length cannot be 0 or less."
# sz = size s
| sz <= l
= s
# required = case sz rem l of
0 -> (sz/l) * (l+1) - 1
r -> (sz/l) * (l+1) + r
= copy s 0 l (createArray required '\0') 0
where
addLineBreaks` :: !.String !.String !Length -> .String
addLineBreaks` src dest len
| len >= (size src) = dest +++. src
| otherwise = addLineBreaks` (src % (len,(size src))) (dest+++(src % (0,len-1))+++"\n") len
copy :: !.String !Int !Int !*String !Int -> .String
copy src src_o remaining dest dest_o
| src_o >= size src
= dest
| remaining == 0
= copy src src_o l {dest & [dest_o]='\n'} (dest_o+1)
= copy src (src_o+1) (remaining-1) {dest & [dest_o]=src.[src_o]} (dest_o+1)
base64Decode :: !.String -> .String
base64Decode s = decodeString (removeLineBreaks s) decodeWithStdAlphabet
base64Decode s = decodeString s decodeWithStdAlphabet
base64URLDecode :: !.String -> .String
base64URLDecode s = decodeString (removeLineBreaks s) decodeWithUrlAlphabet
base64URLDecode s = decodeString s decodeWithUrlAlphabet
decodeString :: !.String !Alphabet -> .String
decodeString s a
| srcSize bitand 3 <> 0 = abort "Base64: Invalid length, size of decoding string must be a multitude of 4."
#! destString = createArray destSize '\0'
= decodeString` destString 0 0
where
decodeString` :: !*{#Char} !Int !Int -> *{#Char}
decodeString` dest src_o dest_o
| src_o < srcSize - 4 = decodeString` (decodeCommonOctet dest src_o dest_o) (src_o + 4) (dest_o + 3)
| src_o < srcSize = decodeLastOctet dest
| otherwise = dest
where
decodeLastOctet :: !*{#Char} -> *{#Char}
decodeLastOctet dest
| s.[src_o + 2] == '='
// lose the last four obsolete bits (2*6-8b)
# oct = (fromChar a.[toInt s.[src_o]] << 2) +
(fromChar a.[toInt s.[src_o + 1]] >> 4)
# dest & [dest_o] = toChar oct
= dest
| s.[src_o + 3] == '='
#! oct = (fromChar a.[toInt s.[src_o]] << 10) +
(fromChar a.[toInt s.[src_o + 1]] << 4) +
(fromChar a.[toInt s.[src_o + 2]] >> 2)
// lose the last two obsolete bits (3*6-2*8b)
# dest & [dest_o+1] = toChar oct
# dest & [dest_o] = toChar (oct >> 8)
= dest
| otherwise = decodeCommonOctet dest src_o dest_o
decodeCommonOctet :: !*String !Int !Int -> *String
decodeCommonOctet dest src_o dest_o
#! oct = ((fromChar a.[toInt (s.[src_o])]) << 18) +
((fromChar a.[toInt (s.[src_o + 1])]) << 12) +
((fromChar a.[toInt (s.[src_o + 2])]) << 6) +
(fromChar a.[toInt (s.[src_o + 3])])
# dest & [dest_o + 2] = toChar oct
# dest & [dest_o + 1] = toChar (oct >> 8)
# dest & [dest_o] = toChar (oct >> 16)
= dest
srcSize = size s
destSize
| srcSize == 0 = 0
#! d = srcSize * 3 / 4
| s.[srcSize - 2] == '=' = d - 2
| s.[srcSize - 1] == '=' = d - 1
| otherwise = d
removeLineBreaks :: !{#Char} -> {#Char}
removeLineBreaks src
// = {char \\ char <-: src | char <> '\n'}
#! n_line_breaks = count_line_breaks 0 0 src
| n_line_breaks==0
= src
#! s = createArray (size src-n_line_breaks) '\0';
= copy_without_line_breaks 0 0 src s
#! (sz,s) = usize s
#! (destSize,s) = decodedSize s
#! destString = createArray destSize '\0'
= decodeString` s sz a destString 0 0
base64DecodeUnique :: !*String -> .String
base64DecodeUnique s = decodeUnique s decodeWithStdAlphabet
base64URLDecodeUnique :: !*String -> .String
base64URLDecodeUnique s = decodeUnique s decodeWithUrlAlphabet
decodeUnique :: !*String !Alphabet -> .String
decodeUnique s a
#! (destSize,s) = decodedSize s
#! (src,dest) = duplicate s
#! dest = decodeString` src (size src) a dest 0 0
= setLength destSize dest
where
copy_without_line_breaks :: !Int !Int !{#Char} !*{#Char} -> *{#Char}
copy_without_line_breaks s_i d_i s d
| s_i<size s
| s.[s_i]<>'\n'
#! d & [d_i] = s.[s_i]
= copy_without_line_breaks (s_i + 1) (d_i + 1) s d
= copy_without_line_breaks (s_i + 1) d_i s d
= d
count_line_breaks :: !Int !Int !{#Char} -> Int
count_line_breaks i n_line_breaks s
| i<size s
| s.[i]<>'\n'
= count_line_breaks (i + 1) n_line_breaks s
= count_line_breaks (i + 1) (n_line_breaks + 1) s
= n_line_breaks
duplicate :: !.String -> (!String, !.String)
duplicate s = code {
push_a 0
}
// This function destructively updates the length of the string. Because
// the decoded value is always shorter than the original value, this can be
// done safely (i.e., we don't have to worry about corrupting the elements
// on the heap after this string). The leftover bytes will be ignored by
// the garbage collector (it is comparable to the case where a thunk is
// overwritten by a smaller head normal form).
// Note that we cannot use `pushI -2; update INT 0 1` because this will
// cause a runtime error when checking indexes (clm's -ci) is enabled.
setLength :: !Int !.String -> .String
setLength len s = code {
fill_r _STRING_ 0 1 0 0 0
pop_b 1
}
decodedSize :: !u:String -> (!Int, !u:String)
decodedSize s
#! (srcSize,s) = usize s
| srcSize == 0 = (0,s)
#! (nnl,s) = countNewlines (srcSize-1) 0 s
#! (neq,s) = countEqualSigns (srcSize-1) 0 s
= ((srcSize-nnl)*3/4-neq,s)
where
countNewlines :: !Int !Int !u:String -> (!Int, !u:String)
countNewlines -1 n s = (n,s)
countNewlines i n s
# (c,s) = s![i]
= case c of
'\n' -> countNewlines (i-1) (n+1) s
_ -> countNewlines (i-1) n s
countEqualSigns :: !Int !Int !u:String -> (!Int, !u:String)
countEqualSigns -1 n s = (n,s)
countEqualSigns i n s
# (c,s) = s![i]
= case c of
'=' -> countEqualSigns (i-1) (n+1) s
'\n' -> countEqualSigns (i-1) n s
_ -> (n,s)
decodeString` :: !.String !Int !Alphabet !*{#Char} !Int !Int -> *{#Char}
decodeString` s sz a dest src_o dest_o
#! (c1,src_o,s) = nextChar s src_o sz
#! (c2,src_o,s) = nextChar s src_o sz
#! (c3,src_o,s) = nextChar s src_o sz
#! (c4,src_o,s) = nextChar s src_o sz
| c4 == '\0'
| c1 == '\0'
= dest
= abort "invalid base64 input: not a multiple of 4\n"
| c3 == '=' // lose the last four padding bits
# oct =
(toInt a.[toInt c1] << 2) +
(toInt a.[toInt c2] >> 4)
= {dest & [dest_o]=toChar oct}
| c4 == '=' // lose the last two obsolete bits
# oct =
(toInt a.[toInt c1] << 10) +
(toInt a.[toInt c2] << 4) +
(toInt a.[toInt c3] >> 2)
= {dest & [dest_o]=toChar (oct >> 8), [dest_o+1]=toChar oct}
| otherwise
# oct =
(toInt a.[toInt c1] << 18) +
(toInt a.[toInt c2] << 12) +
(toInt a.[toInt c3] << 6) +
(toInt a.[toInt c4])
# dest = {dest & [dest_o]=toChar (oct >> 16), [dest_o+1]=toChar (oct >> 8), [dest_o+2]=toChar oct}
= decodeString` s sz a dest src_o (dest_o+3)
where
nextChar :: !u:String !Int !Int -> (!Char, !Int, !u:String)
nextChar s i size
| i >= size = ('\0', i, s)
# (c,s) = s![i]
| c == '\n' = nextChar s (i+1) size
| otherwise = (c, i+1, s)
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment