Hash :
b0ab5bb5
Author :
Thomas de Grivel
Date :
2022-12-04T18:50:53
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135
;; cl-unix-cybernetics
;; Copyright 2013-2022 Thomas de Grivel <thodg@kmx.io>
;;
;; Permission is hereby granted to use this software granted
;; the above copyright notice and this permission paragraph
;; are included in all copies and substantial portions of this
;; software.
;;
;; THIS SOFTWARE IS PROVIDED "AS-IS" WITHOUT ANY GUARANTEE OF
;; PURPOSE AND PERFORMANCE. IN NO EVENT WHATSOEVER SHALL THE
;; AUTHOR BE CONSIDERED LIABLE FOR THE USE AND PERFORMANCE OF
;; THIS SOFTWARE.
(in-package :cl-unix-cybernetics)
(in-re-readtable)
;; Syntaxes
(define-syntax group<5> (name passwd
(#'parse-integer gid)
((lambda (m) (cl-ppcre:split "," m)) members))
#~|^([^:]*):([^:]*):([^:]*):([^:\s]*)\s*$|
"Syntax of the group permissions file /etc/group. See group(5).")
(define-syntax passwd<5> (name pass
(#'parse-integer uid gid)
realname home
(#'strip-last-newline shell))
#~|^([^:]*):([^:]*):([^:]*):([^:]*):([^:]*):([^:]*):([^:]*)$|
"Syntax for the password file /etc/passwd. See passwd(5).")
(define-syntax ls<1>-lT (mode
(#'sh-parse-integer links)
owner
group
(#'sh-parse-integer size)
(#'chronicity:parse time)
name
target)
#~|^([-a-zA-Z]{10})\s+([0-9]+)\s+(\S+)\s+(\S+)\s+([0-9]+)\s+(\S+\s+\S+ \S+ \S+)\s+(.+?)(?: -> (.*))?$|
"Syntax for `ls -lT` output. See ls(1)."
(values name mode links owner group size time target))
(define-syntax stat<1>-r ((#'sh-parse-integer
dev ino mode links uid gid rdev size)
(#'parse-unix-timestamp atime mtime ctime)
(#'sh-parse-integer blksize blocks flags)
file)
#~|^([0-9]+) ([0-9]+) ([0-9]+) ([0-9]+) ([0-9]+) ([0-9]+) ([0-9]+) ([0-9]+) ([0-9]+) ([0-9]+) ([0-9]+) ([0-9]+) ([0-9]+) ([0-9]+) (.+)$|
"Syntax for raw stat(1) output."
(values file dev ino mode links uid gid rdev size
atime mtime ctime blksize blocks flags))
(define-syntax cksum<1>-legacy (sum size file)
#~|(\S+) (\S+) (\S+)|
"Syntax for cksum(1) legacy output.")
(define-syntax cksum<1> (algo sum file)
#~|(\S+) \((.*)\) = (\S+)|
"Syntax for cksum(1) output.")
(define-syntax mount<8> (device mp type options)
#~|^\s*(\S+)\s+on\s+(\S+)\s+type\s+(\S+)\s+\(([^\)]+)\)|
"Syntax for mount(8) list of mounted filesystems."
(values device mp type (re-matches #~|[^\s,]+| options)))
(define-syntax fstab<5> (device mp type options freq passno)
#~|^\s*([^\s#]+)\s+([^\s#]+)\s+([^\s#]+)\s+([^\s#]+)\s+([^\s#]+)\s+([^\s#]+)|
"Syntax for /etc/fstab, see fstab(5)."
(values device mp type
(re-matches #~|[^,]+| options)
(when freq (parse-integer freq))
(when passno (parse-integer passno))))
(defun parse-ps-time (string)
(or (re-bind #~|^\s*([0-9]+):([0-9]*\.[0-9]*)$| (d h) string
(let* ((id (if d (parse-integer d) 0))
(nh (if h (parse-number h) 0))
(id-sec (* 3600 24 id))
(nh-sec (* 3600 nh))
(ih-sec (truncate nh-sec))
(sec (+ id-sec ih-sec)))
(declare (type fixnum id nh id-sec nh-sec sec))
sec))
(error "Invalid ps(1) time ?")))
(define-syntax ps<1>-u (user
(#'parse-number pid cpu mem vsz rss)
tt state
(#'chronicity:parse start)
(#'parse-ps-time time)
cmd)
#~|^\s*(\S+)\s+([0-9]+)\s+([0-9.]+)\s+([0-9.]+)\s+([0-9]+)\s+([0-9]+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(.*)$|
"Syntax for ps -u, see ps(1).")
(define-constant +sh-whitespace+
(str #\Space #\Tab #\Newline)
:test 'equal)
(define-constant +sh-meta+
"<>|;()&"
:test 'equal)
(define-constant +sh-word-delimiters+
(str +sh-whitespace+ +sh-meta+)
:test 'equal)
(defun sh-word-delimiter-p (char)
(find char +sh-word-delimiters+ :test #'eq))
(defun parse-sh-var-value (string)
(declare (type string string))
(with-output-to-string (out)
(let ((quote)
(backslash)
(i 0))
(declare (type fixnum i))
(loop
(unless (< i (length string))
(return))
(let ((c (char string i)))
(cond
(backslash (setq backslash nil) (write-char c out))
((and (eq #\\ c) (not (eq #\' quote))) (setq backslash t))
((eq quote c) (setq quote nil))
((and (null quote) (or (eq #\" c) (eq #\' c))) (setq quote c))
((and (null quote) (sh-word-delimiter-p c)) (return))
(:otherwise (write-char c out))))
(incf i))
(when (or quote backslash)
(error "Unmatched quote")))))
(define-syntax sh-var (var (#'parse-sh-var-value value))
#~|^\s*(\w+)=(.*)|)