Merge remote-tracking branch 'origin/master' into core-updates-frozen

1 files changed, 46 insertions, 3 deletions

diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index 99a3b45004..b305133c37 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -180,6 +180,8 @@
             terminal-window-size
             terminal-columns
             terminal-rows
+            openpty
+            login-tty
 
             utmpx?
             utmpx-login-type
@@ -422,15 +424,21 @@ expansion-time error is raised if FIELD does not exist in TYPE."
   "Evaluate EXPR and restart upon EINTR.  Return the value of EXPR."
   (call-with-restart-on-EINTR (lambda () expr)))
 
-(define (syscall->procedure return-type name argument-types)
+(define* (syscall->procedure return-type name argument-types
+                             #:key library)
   "Return a procedure that wraps the C function NAME using the dynamic FFI,
-and that returns two values: NAME's return value, and errno.
+and that returns two values: NAME's return value, and errno.  When LIBRARY is
+specified, look up NAME in that library rather than in the global symbol name
+space.
 
 If an error occurs while creating the binding, defer the error report until
 the returned procedure is called."
   (catch #t
     (lambda ()
-      (let ((ptr (dynamic-func name (dynamic-link))))
+      (let ((ptr (dynamic-func name
+                               (if library
+                                   (dynamic-link library)
+                                   (dynamic-link)))))
         ;; The #:return-errno? facility was introduced in Guile 2.0.12.
         (pointer->procedure return-type ptr argument-types
                             #:return-errno? #t)))
@@ -2286,6 +2294,41 @@ PORT, trying to guess a reasonable value if all else fails.  The result is
 always a positive integer."
   (terminal-dimension window-size-rows port (const 25)))
 
+(define openpty
+  (let ((proc (syscall->procedure int "openpty" '(* * * * *)
+                                  #:library "libutil")))
+    (lambda ()
+      "Return two file descriptors: one for the pseudo-terminal control side,
+and one for the controlled side."
+      (let ((head     (make-bytevector (sizeof int)))
+            (inferior (make-bytevector (sizeof int))))
+        (let-values (((ret err)
+                      (proc (bytevector->pointer head)
+                            (bytevector->pointer inferior)
+                            %null-pointer %null-pointer %null-pointer)))
+          (unless (zero? ret)
+            (throw 'system-error "openpty" "~A"
+                   (list (strerror err))
+                   (list err))))
+
+        (let ((* (lambda (bv)
+                   (bytevector-sint-ref bv 0 (native-endianness)
+                                        (sizeof int)))))
+          (values (* head) (* inferior)))))))
+
+(define login-tty
+  (let* ((proc (syscall->procedure int "login_tty" (list int)
+                                   #:library "libutil")))
+    (lambda (fd)
+      "Make FD the controlling terminal of the current process (with the
+TIOCSCTTY ioctl), redirect standard input, standard output and standard error
+output to this terminal, and close FD."
+      (let-values (((ret err) (proc fd)))
+        (unless (zero? ret)
+          (throw 'system-error "login-pty" "~A"
+                 (list (strerror err))
+                 (list err)))))))
+
 
 ;;;
 ;;; utmpx.