;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 David Thompson <davet@gnu.org>
;;;
;;; This file is part of GNU Guix.
interface-address
interface-netmask
interface-broadcast-address
- network-interfaces))
+ network-interfaces
+
+ window-size?
+ window-size-rows
+ window-size-columns
+ window-size-x-pixels
+ window-size-y-pixels
+ terminal-window-size
+ terminal-columns))
;;; Commentary:
;;;
(define CLONE_NEWNET #x40000000)
;; The libc interface to sys_clone is not useful for Scheme programs, so the
-;; low-level system call is wrapped instead.
+;; low-level system call is wrapped instead. The 'syscall' function is
+;; declared in <unistd.h> as a variadic function; in practice, it expects 6
+;; pointer-sized arguments, as shown in, e.g., x86_64/syscall.S.
(define clone
(let* ((ptr (dynamic-func "syscall" (dynamic-link)))
- (proc (pointer->procedure int ptr (list int int '*)))
+ (proc (pointer->procedure long ptr
+ (list long ;sysno
+ unsigned-long ;flags
+ '* '* '*
+ '*)))
;; TODO: Don't do this.
(syscall-id (match (utsname:machine (uname))
("i686" 120)
"Create a new child process by duplicating the current parent process.
Unlike the fork system call, clone accepts FLAGS that specify which resources
are shared between the parent and child processes."
- (let ((ret (proc syscall-id flags %null-pointer))
+ (let ((ret (proc syscall-id flags
+ %null-pointer ;child stack
+ %null-pointer %null-pointer ;ptid & ctid
+ %null-pointer)) ;unused
(err (errno)))
(if (= ret -1)
(throw 'system-error "clone" "~d: ~A"
(define %interface-line
;; Regexp matching an interface line in Linux's /proc/net/dev.
- (make-regexp "^[[:blank:]]*([[:alnum:]]+):.*$"))
+ (make-regexp "^[[:blank:]]*([[:graph:]]+):.*$"))
(define (all-network-interface-names)
"Return all the names of the registered network interfaces, including those
(format port "#<interface ~s " name)
(unless (zero? (logand IFF_UP flags))
(display "up " port))
- (if (member (sockaddr:fam address) (list AF_INET AF_INET6))
- (format port "~a " (inet-ntop (sockaddr:fam address)
- (sockaddr:addr address)))
- (format port "family:~a " (sockaddr:fam address)))
+
+ ;; Check whether ADDRESS really is a sockaddr.
+ (when address
+ (if (member (sockaddr:fam address) (list AF_INET AF_INET6))
+ (format port "~a " (inet-ntop (sockaddr:fam address)
+ (sockaddr:addr address)))
+ (format port "family:~a " (sockaddr:fam address))))
+
(format port "~a>" (number->string (object-address interface) 16)))))
(set-record-type-printer! <interface> write-interface)
(let ((ptr (dynamic-func "freeifaddrs" (dynamic-link))))
(pointer->procedure void ptr '(*))))
+\f
+;;;
+;;; Terminals.
+;;;
+
+(define-syntax TIOCGWINSZ ;<asm-generic/ioctls.h>
+ (identifier-syntax #x5413))
+
+(define-record-type <window-size>
+ (window-size rows columns x-pixels y-pixels)
+ window-size?
+ (rows window-size-rows)
+ (columns window-size-columns)
+ (x-pixels window-size-x-pixels)
+ (y-pixels window-size-y-pixels))
+
+(define-c-struct winsize ;<bits/ioctl-types.h>
+ window-size
+ read-winsize
+ write-winsize!
+ (rows unsigned-short)
+ (columns unsigned-short)
+ (x-pixels unsigned-short)
+ (y-pixels unsigned-short))
+
+(define winsize-struct
+ (list unsigned-short unsigned-short unsigned-short unsigned-short))
+
+(define* (terminal-window-size #:optional (port (current-output-port)))
+ "Return a <window-size> structure describing the terminal at PORT, or raise
+a 'system-error' if PORT is not backed by a terminal. This procedure
+corresponds to the TIOCGWINSZ ioctl."
+ (let* ((size (make-c-struct winsize-struct '(0 0 0 0)))
+ (ret (%ioctl (fileno port) TIOCGWINSZ size))
+ (err (errno)))
+ (if (zero? ret)
+ (read-winsize (pointer->bytevector size (sizeof winsize-struct))
+ 0)
+ (throw 'system-error "terminal-window-size" "~A"
+ (list (strerror err))
+ (list err)))))
+
+(define* (terminal-columns #:optional (port (current-output-port)))
+ "Return the best approximation of the number of columns of the terminal at
+PORT, trying to guess a reasonable value if all else fails. The result is
+always a positive integer."
+ (define (fall-back)
+ (match (and=> (getenv "COLUMNS") string->number)
+ (#f 80)
+ ((? number? columns)
+ (if (> columns 0) columns 80))))
+
+ (catch 'system-error
+ (lambda ()
+ (if (file-port? port)
+ (match (window-size-columns (terminal-window-size port))
+ ;; Things like Emacs shell-mode return 0, which is unreasonable.
+ (0 (fall-back))
+ ((? number? columns) columns))
+ (fall-back)))
+ (lambda args
+ (let ((errno (system-error-errno args)))
+ (if (= errno ENOTTY)
+ (fall-back)
+ (apply throw args))))))
+
;;; syscalls.scm ends here
HCoop / jackhill / guix / guix.git / blobdiff