diff --git a/src/clause_types.rs b/src/clause_types.rs index a22b542e..03d60052 100644 --- a/src/clause_types.rs +++ b/src/clause_types.rs @@ -296,6 +296,7 @@ pub(crate) enum SystemClauseType { Ed25519NewKeyPair, Ed25519KeyPairPublicKey, Curve25519ScalarMult, + FirstNonOctet, LoadHTML, LoadXML, GetEnv, @@ -588,6 +589,7 @@ impl SystemClauseType { clause_name!("$ed25519_keypair_public_key") } &SystemClauseType::Curve25519ScalarMult => clause_name!("$curve25519_scalar_mult"), + &SystemClauseType::FirstNonOctet => clause_name!("$first_non_octet"), &SystemClauseType::LoadHTML => clause_name!("$load_html"), &SystemClauseType::LoadXML => clause_name!("$load_xml"), &SystemClauseType::GetEnv => clause_name!("$getenv"), @@ -810,6 +812,7 @@ impl SystemClauseType { ("$ed25519_new_keypair", 1) => Some(SystemClauseType::Ed25519NewKeyPair), ("$ed25519_keypair_public_key", 2) => Some(SystemClauseType::Ed25519KeyPairPublicKey), ("$curve25519_scalar_mult", 3) => Some(SystemClauseType::Curve25519ScalarMult), + ("$first_non_octet", 2) => Some(SystemClauseType::FirstNonOctet), ("$load_html", 3) => Some(SystemClauseType::LoadHTML), ("$load_xml", 3) => Some(SystemClauseType::LoadXML), ("$getenv", 2) => Some(SystemClauseType::GetEnv), diff --git a/src/lib/charsio.pl b/src/lib/charsio.pl index d186eaf4..c8895632 100644 --- a/src/lib/charsio.pl +++ b/src/lib/charsio.pl @@ -10,6 +10,7 @@ :- use_module(library(iso_ext)). :- use_module(library(error)). :- use_module(library(lists)). +:- use_module(library(iso_ext), [partial_string/1,partial_string/3]). fabricate_var_name(VarType, VarName, N) :- char_code('A', AC), @@ -235,10 +236,18 @@ chars_base64(Cs, Bs, Options) :- ; 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), + must_be_characters(Bs), '$chars_base64'(Cs, Bs, Padding, Charset) + ; must_be_characters(Cs), + ( '$first_non_octet'(Cs, N) -> + domain_error(byte_char, N, chars_base64/3) + ; '$chars_base64'(Cs, Bs, Padding, Charset) + ) + ). + +must_be_characters(Cs) :- + ( partial_string(Cs) -> + true + ; must_be(list, Cs), + maplist(must_be(character), Cs) ). diff --git a/src/lib/crypto.pl b/src/lib/crypto.pl index 0e31f3de..3d19a72b 100644 --- a/src/lib/crypto.pl +++ b/src/lib/crypto.pl @@ -46,6 +46,7 @@ :- use_module(library(format)). :- use_module(library(charsio)). :- use_module(library(si)). +:- use_module(library(iso_ext), [partial_string/1]). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - hex_bytes(?Hex, ?Bytes) is det. @@ -104,12 +105,18 @@ must_be_bytes(Bytes, Context) :- must_be_byte_chars(Chars, Context) :- - must_be(list, Chars), - ( member(Char, Chars), - char_code(Char, Code), - \+ between(0, 255, Code) -> - domain_error(byte_char, Char, Context) - ; true + ( partial_string(Chars) -> + ( '$first_non_octet'(Chars, F) -> + domain_error(byte_char, F, Context) + ; true + ) + ; must_be(list, Chars), + ( member(Char, Chars), + char_code(Char, Code), + \+ between(0, 255, Code) -> + domain_error(byte_char, Char, Context) + ; true + ) ). @@ -613,8 +620,11 @@ encoding_chars(octet, Bs, Cs) :- ), must_be_byte_chars(Cs, crypto_encoding). encoding_chars(utf8, Cs, Cs) :- - must_be(list, Cs), - maplist(must_be(character), Cs). + ( partial_string(Cs) -> + true + ; must_be(list, Cs), + maplist(must_be(character), Cs) + ). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Digital signatures with Ed25519 diff --git a/src/lib/format.pl b/src/lib/format.pl index e8964304..db5eb48f 100644 --- a/src/lib/format.pl +++ b/src/lib/format.pl @@ -390,6 +390,13 @@ format(Fs, Args) :- format(Stream, Fs, Args) :- phrase(format_(Fs, Args), Cs), + ( stream_property(Stream, type(binary)) -> + ( '$first_non_octet'(Cs, N) -> + domain_error(byte_char, N, format/3) + ; true + ) + ; true + ), % we use a specialised internal predicate that uses only a % single "write" operation for efficiency. It is equivalent to % maplist(put_char(Stream), Cs). It also works for binary streams. diff --git a/src/machine/system_calls.rs b/src/machine/system_calls.rs index 8b4d7b27..3a12b8bc 100644 --- a/src/machine/system_calls.rs +++ b/src/machine/system_calls.rs @@ -2042,18 +2042,6 @@ impl MachineState { if stream.options().stream_type == StreamType::Binary { for c in string.chars() { - if c as u32 > 255 { - let stub = MachineError::functor_stub(clause_name!("$put_chars"), 2); - - 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); } } else { @@ -5340,6 +5328,18 @@ impl MachineState { let cstr = self.heap.put_complete_string(&string); (self.unify_fn)(self, self[temp_v!(3)], cstr); } + &SystemClauseType::FirstNonOctet => { + for c in self.heap_pstr_iter(self[temp_v!(1)]).to_string().chars() { + if c as u32 > 255 { + let chars = clause_name!(String::from(c.to_string()), self.atom_tbl); + let non_octet = self.heap.to_unifiable(HeapCellValue::Atom(chars, None)); + (self.unify_fn)(self, self[temp_v!(2)], non_octet); + return return_from_clause!(self.last_call, self); + } + } + self.fail = true; + return Ok(()); + } &SystemClauseType::LoadHTML => { let string = self.heap_pstr_iter(self[temp_v!(1)]).to_string(); let doc = select::document::Document::from_read(string.as_bytes()).unwrap(); @@ -5474,18 +5474,6 @@ impl MachineState { } 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);