SCM
yacl_scm_b64url_decode (SCM scmb64)
{
if (!scm_is_string (scmb64))
scm_throw (scm_from_locale_symbol ("BADSTR"), SCM_BOOL_T);
size_t scmb64len, outlen;
char * b64url = scm_to_utf8_stringn (scmb64, &scmb64len);
if (NULL == b64url)
scm_throw (scm_from_locale_symbol ("BADDECODE"), SCM_BOOL_T);
uint8_t *decode = yacl_b64url_decode (b64url, &outlen);
free (b64url);
if (NULL == decode)
scm_throw (scm_from_locale_symbol ("BADDECODED"), SCM_BOOL_T);
SCM b64 = scm_c_make_bytevector (outlen);
memcpy (SCM_BYTEVECTOR_CONTENTS (b64), decode, outlen);
free (decode);
return b64;
}
SCM
yacl_scm_hkdf_sha256 (SCM ikm, SCM salt, SCM info)
{
int rc;
uint8_t * ikm_ptr, *salt_ptr, *info_ptr;
size_t ikm_len, salt_len, info_len;
if (!scm_is_bytevector (ikm))
scm_throw (scm_from_locale_symbol ("BADIKM"), SCM_BOOL_T);
ikm_ptr = SCM_BYTEVECTOR_CONTENTS (ikm);
ikm_len = SCM_BYTEVECTOR_LENGTH (ikm);
if (SCM_UNBNDP (salt))
{
salt_ptr = NULL;
salt_len = 0;
}
else if (!scm_is_bytevector (salt))
scm_throw (scm_from_locale_symbol ("BADSALT"), SCM_BOOL_T);
else
{
salt_ptr = SCM_BYTEVECTOR_CONTENTS(salt);
salt_len = SCM_BYTEVECTOR_LENGTH (salt);
}
if (SCM_UNBNDP (info))
{
info_ptr = NULL;
info_len = 0;
}
else if (!scm_is_bytevector (info))
scm_throw (scm_from_locale_symbol ("BADINFO"), SCM_BOOL_T);
else
{
info_ptr = SCM_BYTEVECTOR_CONTENTS(info);
info_len = SCM_BYTEVECTOR_LENGTH (info);
}
SCM out = scm_c_make_bytevector (YACL_SHA256_LEN);
rc = yacl_hkdf_256(salt_ptr, salt_len,
ikm_ptr, ikm_len,
info_ptr, info_len,
SCM_BYTEVECTOR_CONTENTS (out), YACL_SHA256_LEN);
if (rc)
scm_throw (scm_from_locale_symbol ("BADHKDF"), SCM_BOOL_T);
return out;
}
void
gdbscm_throw (SCM exception)
{
scm_throw (gdbscm_exception_key (exception),
gdbscm_exception_args (exception));
gdb_assert_not_reached ("scm_throw returned");
}
SCM
yacl_scm_b64url_encode (SCM bv)
{
if (!scm_is_bytevector (bv))
scm_throw (scm_from_locale_symbol ("BADBV"), SCM_BOOL_T);
uint8_t *bv_ptr;
size_t bv_len;
bv_ptr = SCM_BYTEVECTOR_CONTENTS (bv);
bv_len = SCM_BYTEVECTOR_LENGTH (bv);
char *b64url = yacl_b64url_encode (bv_ptr, bv_len);
if (NULL == b64url)
scm_throw (scm_from_locale_symbol ("BADENCODE"), SCM_BOOL_T);
SCM out = scm_from_utf8_string (b64url);
free (b64url);
return out;
}
void
scm_avahi_error (int c_err, const char *c_func)
{
SCM err, func;
/* Note: If error code C_ERR is unknown, then ERR will be `#f'. */
err = scm_from_avahi_error (c_err);
func = scm_from_locale_symbol (c_func);
(void) scm_throw (avahi_error_key, scm_list_2 (err, func));
/* XXX: This is actually never reached, but since the Guile headers don't
declare `scm_throw ()' as `noreturn', we must add this to avoid GCC's
complaints. */
abort ();
}
/* returns a (sec . usec) pair. It throws an 'a-sync-exception guile
exception if the library has been configured for monotonic time at
configuration time but it is not in fact supported, but this is not
worth testing for by user code as it should never happen - the
library configuration macros should always give the correct
answer */
static SCM get_time(void) {
#ifdef HAVE_MONOTONIC_CLOCK
struct timespec ts;
if (clock_gettime(CLOCK_MONOTONIC, &ts) == -1) {
scm_throw(scm_from_latin1_symbol("a-sync-exception"),
scm_list_4(scm_from_latin1_string("get-time"),
scm_from_latin1_string("guile-a-sync2: ~A"),
scm_list_1(scm_from_latin1_string("monotonic time not supported "
"by underlying implementation")),
scm_from_int(errno)));
}
return scm_cons(scm_from_size_t(ts.tv_sec), scm_from_long(ts.tv_nsec/1000L));
#else
return scm_gettimeofday();
#endif
}
SCM
yacl_scm_get_random (SCM len)
{
if (!scm_is_integer (len))
goto EXCEPTION;
size_t rndlen = scm_to_size_t (len);
SCM rnd = scm_c_make_bytevector (rndlen);
int rc = yacl_get_random(SCM_BYTEVECTOR_CONTENTS (rnd), rndlen);
if (rc)
goto EXCEPTION;
else
goto OUT;
EXCEPTION:
scm_throw (scm_from_locale_symbol ("BADRANDOM"), SCM_BOOL_T);
OUT:
return rnd;
}
static void py2scm_exception(void)
{
PyObject *ptype = NULL, *pvalue = NULL, *ptraceback = NULL;
PyErr_Fetch(&ptype, &pvalue, &ptraceback);
PyObject *pvalue_str = NULL;
if (pvalue) {
pvalue_str = PyObject_Str(pvalue);
if (pvalue_str == NULL)
PyErr_Clear();
}
scm_throw(scm_from_utf8_symbol("python-exception"),
scm_list_2(scm_from_locale_string(
((PyTypeObject *)ptype)->tp_name),
pvalue_str != NULL && PyObject_IsTrue(pvalue_str)
? scm_from_locale_string(
PyString_AsString(pvalue_str))
: SCM_BOOL_F));
/* does not return */
fprintf(stderr, "*** scm_error shouldn't have returned ***\n");
}
static void
guile_error_handler(char* msg)
{
scm_throw(scm_from_locale_symbol("parser-error"), scm_from_locale_string(msg));
}
