unofficial mirror of guile-user@gnu.org 
 help / color / mirror / Atom feed
* Calling back scheme from C
@ 2020-09-22  6:25 divoplade
  2020-09-22  9:50 ` Chris Vine
  2020-09-22 15:48 ` divoplade
  0 siblings, 2 replies; 5+ messages in thread
From: divoplade @ 2020-09-22  6:25 UTC (permalink / raw)
  To: guile-user

[-- Attachment #1: Type: text/plain, Size: 1612 bytes --]

Hello guile,

I am having a hard time understanding what I do wrong when trying to
pass a guile function as a C callback (from C).

You should be able to trigger the bug by saving the 3 attached files
and running:

    guix build -L . pkg-with-the-bug

The bug disappears when ignoring the scheme callback, so I suspect it
has something to do with the callback and not further functions:

    guix build -L . pkg-without-the-bug

Does anyone see an error?

You will find the C code under libguile-nettle.c. guile-nettle.c is
just an ad-hoc interpreter with the primitives built in, to run the
test. The test is example-rsa-sign.in: it defines a callback that will
return a bytevector of length its argument, and that bytevector will be
processed to generate an RSA key pair with nettle. The function with-
rsa-generated-key-pair takes the callback plus other arguments and a
function, and it will call that function with the public key and the
private key.

(define (random-with-guile length)
  (use-modules (srfi srfi-1))
  (use-modules (rnrs bytevectors))
  (u8-list->bytevector
   (unfold (lambda (i) (>= i length))
	   (lambda (i) (random 256))
	   1+
	   0)))

(define (generate-rsa-keypair nbits random progress)
  (with-rsa-generated-key-pair random progress nbits 16
    (lambda (public private)
      (rsa-public-key-n public))))

(define keypair
  (generate-rsa-keypair 2048 random-with-guile #f))

(if keypair
    (format #t "The key pair has been generated.\n")
    (begin
      (format (current-error-port)
	      "The key pair could not be generated.\n")
      (exit 1)))

Best regards,

divoplade

[-- Attachment #2: bugs.scm --]
[-- Type: text/x-scheme, Size: 1498 bytes --]

(define-module (bugs)
  #:use-module (guix packages)
  #:use-module ((guix licenses) #:prefix license:)
  #:use-module (guix download)
  #:use-module (guix build-system gnu)
  #:use-module (gnu packages)
  #:use-module (gnu packages guile)
  #:use-module (gnu packages nettle)
  #:use-module (gnu packages pkg-config))

(define-public pkg-with-the-bug
  (package
   (name "pkg-with-the-bug")
   (version "0.3.0.8-c2e5")
   (source (origin
            (method url-fetch)
            (uri "guile-nettle-0.3.0.8-c2e5.tar.gz")
            (sha256
             (base32
              "0lmyqc4p6gjgkslkxs925ayh54g35mjn94zljynga1a0bvl7j48l"))))
   (build-system gnu-build-system)
   (arguments `())
   (native-inputs
    `(("pkg-config" ,pkg-config)
      ("guile" ,guile-3.0)))
   (inputs `(("guile" ,guile-3.0)
             ("nettle" ,nettle)))
   (propagated-inputs `())
   (native-search-paths
    (list (search-path-specification
	   (variable "LTDL_LIBRARY_PATH")
	   (files (list "lib/")))))
   (synopsis "")
   (description "")
   (home-page "https://divoplade.fr/guile-nettle.git")
   (license license:gpl3+)))

(define-public pkg-without-the-bug
  (package (inherit pkg-with-the-bug)
	   (name "pkg-without-the-bug")
	   (source
	    (origin
             (method url-fetch)
             (uri "guile-nettle-0.3.0.8-c2e5.tar.gz")
             (sha256
              (base32
               "0lmyqc4p6gjgkslkxs925ayh54g35mjn94zljynga1a0bvl7j48l"))
	     (patches '("disable-function-call.patch"))))))

[-- Attachment #3: disable-function-call.patch --]
[-- Type: text/x-patch, Size: 759 bytes --]

diff -u guile-nettle-0.3.0.8-c2e5/libguile-nettle.c patched/libguile-nettle.c
--- guile-nettle-0.3.0.8-c2e5/libguile-nettle.c	2020-09-22 07:38:24.000000000 +0200
+++ patched/libguile-nettle.c	2020-09-22 08:06:59.044627220 +0200
@@ -30,16 +30,10 @@
 static void
 guile_nettle_random_func (void *ctx, size_t length, uint8_t * dst)
 {
-  SCM *cb = ctx;
-  SCM scm_length = scm_from_size_t (length);
-  SCM random_data = scm_call_1 (*cb, scm_length);
-  size_t output_length = scm_c_bytevector_length (random_data);
   size_t i;
-  SCM_ASSERT (output_length == length,
-              *cb, SCM_ARGn, "generating random data");
   for (i = 0; i < length; i++)
     {
-      dst[i] = scm_c_bytevector_ref (random_data, i);
+      dst[i] = rand () % 256;
     }
 }
 

[-- Attachment #4: guile-nettle-0.3.0.8-c2e5.tar.gz --]
[-- Type: application/x-compressed-tar, Size: 399711 bytes --]

^ permalink raw reply	[flat|nested] 5+ messages in thread

end of thread, other threads:[~2020-09-22 15:48 UTC | newest]

Thread overview: 5+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2020-09-22  6:25 Calling back scheme from C divoplade
2020-09-22  9:50 ` Chris Vine
2020-09-22 10:36   ` divoplade
2020-09-22 14:47     ` Chris Vine
2020-09-22 15:48 ` divoplade

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).