From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp1 ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms0.migadu.com with LMTPS id KlUAJu6abmF1tgAAgWs5BA (envelope-from ) for ; Tue, 19 Oct 2021 12:16:14 +0200 Received: from aspmx1.migadu.com ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp1 with LMTPS id qF0LIe6abmH4UgAAbx9fmQ (envelope-from ) for ; Tue, 19 Oct 2021 10:16:14 +0000 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by aspmx1.migadu.com (Postfix) with ESMTPS id 2124BA46F for ; Tue, 19 Oct 2021 12:16:14 +0200 (CEST) Received: from localhost ([::1]:52808 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1mcmAH-0006Qn-8z for larch@yhetil.org; Tue, 19 Oct 2021 06:16:13 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:35508) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1mcm8A-0003vn-Ev for guix-patches@gnu.org; Tue, 19 Oct 2021 06:14:02 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:37916) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1mcm8A-0007nk-5W for guix-patches@gnu.org; Tue, 19 Oct 2021 06:14:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1mcm8A-0007IV-14 for guix-patches@gnu.org; Tue, 19 Oct 2021 06:14:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#51285] [PATCH 1/3] syscalls: Add 'openpty' and 'login-tty'. References: <20211019100351.9726-1-ludo@gnu.org> In-Reply-To: <20211019100351.9726-1-ludo@gnu.org> Resent-From: Ludovic =?UTF-8?Q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Tue, 19 Oct 2021 10:14:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 51285 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 51285@debbugs.gnu.org Cc: Ludovic =?UTF-8?Q?Court=C3=A8s?= Received: via spool by 51285-submit@debbugs.gnu.org id=B51285.163463842327994 (code B ref 51285); Tue, 19 Oct 2021 10:14:01 +0000 Received: (at 51285) by debbugs.gnu.org; 19 Oct 2021 10:13:43 +0000 Received: from localhost ([127.0.0.1]:49456 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mcm7q-0007HR-W0 for submit@debbugs.gnu.org; Tue, 19 Oct 2021 06:13:43 -0400 Received: from eggs.gnu.org ([209.51.188.92]:33464) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mcm7p-0007HC-O3 for 51285@debbugs.gnu.org; Tue, 19 Oct 2021 06:13:42 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:47970) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1mcm7k-0007TN-Gx; Tue, 19 Oct 2021 06:13:36 -0400 Received: from 91-160-117-201.subs.proxad.net ([91.160.117.201]:59236 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1mcm7j-0005AA-Re; Tue, 19 Oct 2021 06:13:36 -0400 From: Ludovic =?UTF-8?Q?Court=C3=A8s?= Date: Tue, 19 Oct 2021 12:13:09 +0200 Message-Id: <20211019101311.10174-1-ludo@gnu.org> X-Mailer: git-send-email 2.33.0 MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+larch=yhetil.org@gnu.org Sender: "Guix-patches" X-Migadu-Flow: FLOW_IN ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=yhetil.org; s=key1; t=1634638574; h=from:from:sender:sender:reply-to:subject:subject:date:date: message-id:message-id:to:to:cc:cc:mime-version:mime-version: content-transfer-encoding:content-transfer-encoding:resent-cc: resent-from:resent-sender:resent-message-id:in-reply-to:in-reply-to: references:references:list-id:list-help:list-unsubscribe: list-subscribe:list-post; bh=idn/l/C2vBScKSFk7W3InFTtQgHM4m57KLLLH4uHs5w=; b=ZH6dOC8fz5lcSKrIsA5D1mr2XeerwKyGhSy5j4bJgSiCOqowcwTYjkkqKBFVJUpDjvizVM 32n+REDk12AWE0D8NNtTsOywl4YV7Nwmif5L0Wpn3GIwHlYWsX/I1vAyELgvBCLILzToTh WMbAO/IJkgh8TYsgoC7rhDB4e8ue30LbtK2MPUd6u+wulSyajgzP7I6r0bmNeLmFcKZHhs 3Niw6AJZkhcaTNxlneaiMObnLkcLY0U30jKXjZZB3GWV4VLFMShV8thXgwFV5Va8DuSBAo tM9D822biDGidrgucmX7JCNiMvSiec2PclxkdRaLcCubZMCqdUFetPWp1aXvig== ARC-Seal: i=1; s=key1; d=yhetil.org; t=1634638574; a=rsa-sha256; cv=none; b=nckfG6XfkbaNAi9Qe+RR0toryiL1UjOmjBJ0L+8YcpGA/itDgTAC2qdU+tUtrapYAHkaDk iKf/5a1cNHRFsVAM2ZiKoJJRlwDpRN12D2zmzMycKXV17aPZxhaVZ1LmHmlvAXXEdYZgD2 DgFaNtKnkDeGKKQsq0Cm8ckdYAIsbj67XkmZlkJ2DFp/jGXroQ6MoQNBxWAwXjQ2BMr0Du W0BTjwKtf6vN1/XWax4j6IdxUNqaFKad7BjWJbVjQc2ij0WccYruaOPJ5urD5NFUdK1yey KxtU/fSKpMPuK3gMfv7LslmuWFp1aYTHF3yxcS1mYSjFW21C2R1DbCA+S0dwlQ== ARC-Authentication-Results: i=1; aspmx1.migadu.com; dkim=none; dmarc=pass (policy=none) header.from=gnu.org; spf=pass (aspmx1.migadu.com: domain of guix-patches-bounces@gnu.org designates 209.51.188.17 as permitted sender) smtp.mailfrom=guix-patches-bounces@gnu.org X-Migadu-Spam-Score: 2.07 Authentication-Results: aspmx1.migadu.com; dkim=none; dmarc=pass (policy=none) header.from=gnu.org; spf=pass (aspmx1.migadu.com: domain of guix-patches-bounces@gnu.org designates 209.51.188.17 as permitted sender) smtp.mailfrom=guix-patches-bounces@gnu.org X-Migadu-Queue-Id: 2124BA46F X-Spam-Score: 2.07 X-Migadu-Scanner: scn0.migadu.com X-TUID: MBJwzqJWE2jE * guix/build/syscalls.scm (openpty, login-pty): New procedures. * tests/syscalls.scm ("openpty", "openpty + login-tty"): New tests. --- guix/build/syscalls.scm | 39 +++++++++++++++++++++++++++++++++++++++ tests/syscalls.scm | 35 +++++++++++++++++++++++++++++++++++ 2 files changed, 74 insertions(+) diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index 99a3b45004..7ea6b56e54 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -180,6 +180,8 @@ (define-module (guix build syscalls) terminal-window-size terminal-columns terminal-rows + openpty + login-tty utmpx? utmpx-login-type @@ -2286,6 +2288,43 @@ (define* (terminal-rows #:optional (port (current-output-port))) always a positive integer." (terminal-dimension window-size-rows port (const 25))) +(define openpty + (let* ((ptr (dynamic-func "openpty" (dynamic-link "libutil"))) + (proc (pointer->procedure int ptr '(* * * * *) + #:return-errno? #t))) + (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* ((ptr (dynamic-func "login_tty" (dynamic-link "libutil"))) + (proc (pointer->procedure int ptr (list int) + #:return-errno? #t))) + (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. diff --git a/tests/syscalls.scm b/tests/syscalls.scm index 706dd4177f..c9e011f453 100644 --- a/tests/syscalls.scm +++ b/tests/syscalls.scm @@ -26,6 +26,7 @@ (define-module (test-syscalls) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (srfi srfi-64) + #:use-module (srfi srfi-71) #:use-module (system foreign) #:use-module ((ice-9 ftw) #:select (scandir)) #:use-module (ice-9 match)) @@ -582,6 +583,40 @@ (define perform-container-tests? (test-assert "terminal-rows" (> (terminal-rows) 0)) +(test-assert "openpty" + (let ((head inferior (openpty))) + (and (integer? head) (integer? inferior) + (let ((port (fdopen inferior "r+0"))) + (and (isatty? port) + (begin + (close-port port) + (close-fdes head) + #t)))))) + +(test-equal "openpty + login-tty" + '(hello world) + (let ((head inferior (openpty))) + (match (primitive-fork) + (0 + (dynamic-wind + (const #t) + (lambda () + (setvbuf (current-input-port) 'none) + (close-fdes head) + (login-tty inferior) + (write (read)) + (read)) ;this gets EIO when HEAD is closed + (lambda () + (primitive-_exit 42)))) + (pid + (close-fdes inferior) + (let ((head (fdopen head "r+0"))) + (write '(hello world) head) + (let ((result (read head))) + (close-port head) + (waitpid pid) + result)))))) + (test-assert "utmpx-entries" (match (utmpx-entries) (((? utmpx? entries) ...) -- 2.33.0