rishi/scryer-prolog
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Merge pull request #638 from triska/base64

Browse Source 
ADDED: chars_base64/3 for efficient bidirectional Base64 conversion.
This commit is contained in:
Mark Thom
2020-07-23 19:49:12 -03:00
committed by GitHub
parent 82dfa690d2 928c9c9aad
commit e7c27ed999
6 changed files with 138 additions and 55 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
Cargo.toml
View File

@@ -46,3 +46,4 @@ native-tls = "0.2.4"
chrono = "0.4.11"
select = "0.4.3"
roxmltree = "0.11.0"
base64 = "0.12.3"

7
README.md
View File

@@ -387,9 +387,10 @@ The modules that ship with Scryer Prolog are also called
file, reading lazily only as much as is needed. Due to the compact
internal string representation, also extremely large files can be
efficiently processed with Scryer Prolog in this way.
* [`charsio`](src/lib/charsio.pl) Various predicates that are
useful for parsing and reasoning about characters, notably
`char_type/2` to classify characters according to their type.
* [`charsio`](src/lib/charsio.pl) Various predicates that are useful
for parsing and reasoning about characters, notably `char_type/2` to
classify characters according to their type, and conversion
predicates for different encodings of strings.
* [`error`](src/lib/error.pl)
`must_be/2` and `can_be/2` complement the type checks provided by
[`library(si)`](src/lib/si.pl), and are especially useful for

3
src/clause_types.rs
View File

@@ -314,6 +314,7 @@ pub enum SystemClauseType {
GetEnv,
SetEnv,
UnsetEnv,
CharsBase64,
}
impl SystemClauseType {
@@ -526,6 +527,7 @@ impl SystemClauseType {
&SystemClauseType::GetEnv => clause_name!("$getenv"),
&SystemClauseType::SetEnv => clause_name!("$setenv"),
&SystemClauseType::UnsetEnv => clause_name!("$unsetenv"),
&SystemClauseType::CharsBase64 => clause_name!("$chars_base64"),
}
}
@@ -718,6 +720,7 @@ impl SystemClauseType {
("$getenv", 2) => Some(SystemClauseType::GetEnv),
("$setenv", 2) => Some(SystemClauseType::SetEnv),
("$unsetenv", 1) => Some(SystemClauseType::UnsetEnv),
("$chars_base64", 4) => Some(SystemClauseType::CharsBase64),
_ => None,
}
}

48
src/lib/charsio.pl
View File

@@ -3,7 +3,8 @@
get_single_char/1,
read_line_to_chars/3,
read_term_from_chars/2,
write_term_to_chars/3]).
write_term_to_chars/3,
chars_base64/3]).
:- use_module(library(dcgs)).
:- use_module(library(iso_ext)).
@@ -194,3 +195,48 @@ read_line_to_chars(Stream, Cs0, Cs) :-
; read_line_to_chars(Stream, Rest, Cs)
)
).
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Relation between a list of characters Cs and its Base64 encoding Bs,
also a list of characters.
At least one of the arguments must be instantiated.
Options are:
- padding(Boolean)
Whether to use padding: true (the default) or false.
- charset(C)
Either 'standard' (RFC 4648 §4, the default) or 'url' (RFC 4648 §5).
Example:
?- chars_base64("hello", Bs, []).
Bs = "aGVsbG8="
; false.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
chars_base64(Cs, Bs, Options) :-
must_be(list, Options),
( member(O, Options), var(O) ->
instantiation_error(chars_base64/3)
; ( member(padding(Padding), Options) -> true
; Padding = true
),
( member(charset(Charset), Options) -> true
; Charset = standard
)
),
must_be(boolean, Padding),
must_be(atom, Charset),
( member(Charset, [standard,url]) -> true
; domain_error(charset, Charset, chars_base64/3)
),
( var(Cs) ->
must_be(list, Bs),
maplist(must_be(character), Bs),
'$chars_base64'(Cs, Bs, Padding, Charset)
; must_be(list, Cs),
maplist(must_be(character), Cs),
'$chars_base64'(Cs, Bs, Padding, Charset)
).

58
src/lib/crypto.pl
View File

@@ -426,61 +426,17 @@ crypto_password_hash(Password0, Hash, Options) :-
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Bidirectional Bytes <-> Base64 conversion
=========================================
This implements Base64 conversion *without padding*.
Bidirectional Bytes <-> Base64 conversion *without padding*.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
n_base64(0 , 'A'). n_base64(1 , 'B'). n_base64(2 , 'C'). n_base64(3 , 'D').
n_base64(4 , 'E'). n_base64(5 , 'F'). n_base64(6 , 'G'). n_base64(7 , 'H').
n_base64(8 , 'I'). n_base64(9 , 'J'). n_base64(10, 'K'). n_base64(11, 'L').
n_base64(12, 'M'). n_base64(13, 'N'). n_base64(14, 'O'). n_base64(15, 'P').
n_base64(16, 'Q'). n_base64(17, 'R'). n_base64(18, 'S'). n_base64(19, 'T').
n_base64(20, 'U'). n_base64(21, 'V'). n_base64(22, 'W'). n_base64(23, 'X').
n_base64(24, 'Y'). n_base64(25, 'Z'). n_base64(26, 'a'). n_base64(27, 'b').
n_base64(28, 'c'). n_base64(29, 'd'). n_base64(30, 'e'). n_base64(31, 'f').
n_base64(32, 'g'). n_base64(33, 'h'). n_base64(34, 'i'). n_base64(35, 'j').
n_base64(36, 'k'). n_base64(37, 'l'). n_base64(38, 'm'). n_base64(39, 'n').
n_base64(40, 'o'). n_base64(41, 'p'). n_base64(42, 'q'). n_base64(43, 'r').
n_base64(44, 's'). n_base64(45, 't'). n_base64(46, 'u'). n_base64(47, 'v').
n_base64(48, 'w'). n_base64(49, 'x'). n_base64(50, 'y'). n_base64(51, 'z').
n_base64(52, '0'). n_base64(53, '1'). n_base64(54, '2'). n_base64(55, '3').
n_base64(56, '4'). n_base64(57, '5'). n_base64(58, '6'). n_base64(59, '7').
n_base64(60, '8'). n_base64(61, '9'). n_base64(62, '+'). n_base64(63, '/').
bytes_base64(Ls, Bs) :-
( list(Bs), maplist(atom, Bs) ->
maplist(n_base64, Is, Bs),
phrase(bytes_base64_(Ls), Is),
Ls ins 0..255
; phrase(bytes_base64_(Ls), Is),
Is ins 0..63,
maplist(n_base64, Is, Bs)
bytes_base64(Bytes, Base64) :-
( var(Bytes) ->
chars_base64(Chars, Base64, [padding(false)]),
maplist(char_code, Chars, Bytes)
; maplist(char_code, Chars, Bytes),
chars_base64(Chars, Base64, [padding(false)])
).
list(Ls) :-
nonvar(Ls),
( Ls = [] -> true
; Ls = [_|Rest],
list(Rest)
).
bytes_base64_([]) --> [].
bytes_base64_([A]) --> [W,X],
{ A #= W*4 + X//16,
X #= 16*_ }.
bytes_base64_([A,B]) --> [W,X,Y],
{ A #= W*4 + X//16,
B #= (X mod 16)*16 + Y//4,
Y #= 4*_ }.
bytes_base64_([A,B,C|Ls]) --> [W,X,Y,Z],
{ A #= W*4 + X//16,
B #= (X mod 16)*16 + Y//4,
C #= (Y mod 4)*64 + Z },
bytes_base64_(Ls).
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
crypto_data_encrypt(+PlainText,
+Algorithm,

76
src/machine/system_calls.rs
View File

@@ -55,6 +55,7 @@ use crate::native_tls::TlsConnector;
extern crate select;
use roxmltree;
use base64;
pub fn get_key() -> KeyEvent {
let key;
@@ -5745,6 +5746,81 @@ impl MachineState {
let key = self.heap_pstr_iter(self[temp_v!(1)]).to_string();
env::remove_var(key);
}
&SystemClauseType::CharsBase64 => {
let mut options = vec![];
for i in 3..5 {
match self.store(self.deref(self[temp_v!(i)])) {
Addr::Con(h) if self.heap.atom_at(h) => {
if let HeapCellValue::Atom(ref atom, _) = &self.heap[h] {
options.push(atom.as_str());
} else {
unreachable!()
}
}
_ => {
unreachable!()
}
};
}
let config =
if options[0] == "true" {
if options[1] == "standard" {
base64::STANDARD
} else {
base64::URL_SAFE
}
} else {
if options[1] == "standard" {
base64::STANDARD_NO_PAD
} else {
base64::URL_SAFE_NO_PAD
}
};
if self.store(self.deref(self[temp_v!(1)])).is_ref() {
let b64 = self.heap_pstr_iter(self[temp_v!(2)]).to_string();
let bytes = base64::decode_config(b64, config);
match bytes {
Ok(bs) => {
let mut string = String::new();
for c in bs {
string.push(c as char);
}
let cstr = self.heap.put_complete_string(&string);
self.unify(self[temp_v!(1)], cstr);
}
_ => {
self.fail = true;
return Ok(());
}
}
} else {
let mut bytes = vec![];
for c in self.heap_pstr_iter(self[temp_v!(1)]).to_string().chars() {
if c as u32 > 255 {
let stub = MachineError::functor_stub(clause_name!("chars_base64"), 3);
let err = MachineError::type_error(
self.heap.h(),
ValidType::Byte,
Addr::Char(c),
);
return Err(self.error_form(err, stub));
}
bytes.push(c as u8);
}
let b64 = base64::encode_config(bytes, config);
let cstr = self.heap.put_complete_string(&b64);
self.unify(self[temp_v!(2)], cstr);
}
}
};
return_from_clause!(self.last_call, self)