connection: Throw upon errors in FFI bindings.

Ludovic Court??sTue May 23 20:43:55+0200 2023

48f9d8a

connection: Throw upon errors in FFI bindings. * netlink/connection.scm (syscall->procedure): New procedure. (ffi-sendto, ffi-recvmsg, ffi-bind): Use it. Signed-off-by: Julien Lepiller <julien@lepiller.eu>

netlink/connection.scm

11 
;;;; This file is part of Guile Netlink
22 
;;;;
33 
;;;; Copyright (C) 2021 Julien Lepiller <julien@lepiller.eu>
4-
;;;;
4+
;;;; Copyright (C) 2023 Ludovic Court??s <ludo@gnu.org>
5+
;;;;
56 
;;;; This library is free software: you can redistribute it and/or modify
67 
;;;; it under the terms of the GNU General Public License as published by
78 
;;;; the Free Software Foundation, either version 3 of the License, or

…

2425 
  #:use-module (system foreign)
2526 
  #:use-module (srfi srfi-34)
2627 
  #:use-module (srfi srfi-35)
28+
  #:use-module (srfi srfi-71)
2729 
  #:export (connect
2830 
            connect-route
2931 
            close-socket

…

3436 
3537 
(define libc (dynamic-link))
3638 
37-
(define ffi-sendto (pointer->procedure int
38-
                                       (dynamic-func "sendto" libc)
39-
                                       (list int '* size_t int '* int)
40-
                                       #:return-errno? #t))
41-
(define ffi-recvmsg (pointer->procedure int
42-
                                        (dynamic-func "recvmsg" libc)
43-
                                        (list int '* int)))
44-
(define ffi-bind (pointer->procedure int
45-
                                     (dynamic-func "bind" libc)
46-
                                     (list int '* int)))
39+
(define (syscall->procedure return-type function
40+
                            argument-types)
41+
  "Return a procedure that calls FUNCTION, a syscall wrapper from the C library
42+
with the given RETURN-TYPE and ARGUMENT-TYPES."
43+
  (let ((proc (pointer->procedure return-type
44+
                                  (dynamic-func function libc)
45+
                                  argument-types
46+
                                  #:return-errno? #t)))
47+
    (lambda args
48+
      (let ((ret errno (apply proc args)))
49+
        (when (< ret 0)
50+
          (throw 'system-error function "~A"
51+
                 (list (strerror errno)) (list errno)))
52+
        ret))))
53+
54+
(define ffi-sendto
55+
  (syscall->procedure int "sendto" (list int '* size_t int '* int)))
56+
(define ffi-recvmsg
57+
  (syscall->procedure int "recvmsg" (list int '* int)))
58+
(define ffi-bind
59+
  (syscall->procedure int "bind" (list int '* int)))
4760 
4861 
;; define simple functions to open/close sockets
4962 
(define (open-socket proto)