thodg/cl-unix-cybernetics/unix/linux.lisp

Branch - branch -masterv0.3- tag -v0.3.3adams-0.3.2adams-0.3.1adams-0.3adams-0.2adams-0.1

• Show log

  Commit

• Hash : b0ab5bb5
  Author : Thomas de Grivel
  Date : 2022-12-04T18:50:53
  

  cl-unix-cybernetics
  

Download

• unix/linux.lisp

• ;; 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)
  
  (define-syntax ls<1>-l--full-time (mode
                                     (#'sh-parse-integer links)
                                     owner
                                     group
                                     (#'sh-parse-integer size)
                                     (#'chronicity:parse time)
                                     name)
    #~|^([-a-zA-Z]{10})\s+([0-9]+)\s+(\S+)\s+(\S+)\s+([0-9]+)\s+(\S+ \S+ \S+)\s+(.+)$|
    "Syntax for `ls -l --full-time` output. See ls(1).")
  
  (defmethod probe-vnode-using-ls ((vnode vnode) (os os-linux))
    (let ((id (resource-id vnode))
          (ensure :absent))
      (multiple-value-bind (mode links owner group size mtime)
          (with-ls<1>-l--full-time (mode links owner group size mtime name)
              (ls "-ld --full-time" (sh-quote id))
            (when (and name (string= id (the string name)))
              (setq mode (mode (mode-permissions mode))
                    owner (resource 'user owner)
                    group (resource 'group group)
                    ensure :present)
              (return (values mode links owner group size mtime))))
        (properties* ensure mode links owner group size mtime))))
  
  (defun parse-hex (string)
    (parse-integer string :radix 16))
  
  (define-syntax stat<1>-t (file
                            (#'sh-parse-integer size blksize)
                            (#'parse-hex mode)
                            (#'sh-parse-integer uid gid)
                            (#'parse-hex dev)
                            (#'sh-parse-integer ino links)
                            (#'parse-hex major minor)
  			  (#'parse-unix-timestamp atime mtime ctime
                                                    birthtime)
  			  (#'sh-parse-integer optimal-io))
      #~|^(.*) ([0-9]+) ([0-9]+) ([A-Fa-f0-9]+) ([0-9]+) ([0-9]+) ([A-Fa-f0-9]+) ([0-9]+) ([0-9]+) ([A-Fa-f0-9]+) ([A-Fa-f0-9]+) ([0-9.]+) ([0-9.]+) ([0-9.]+) ([0-9.]+) ([0-9]+)$|
    "Syntax for terse stat(1) output on Linux.")
  
  (defmethod probe-vnode-using-stat ((vnode vnode) (os os-linux))
    (let ((id (resource-id vnode))
          (ensure :absent))
      (multiple-value-bind #1=(size blksize mode uid gid dev ino links
                                    major minor atime mtime ctime
                                    birthtime optimal-io)
          (with-stat<1>-t (name . #1#) (stat "-t" (sh-quote id))
            (when (and name (string= id (the string name)))
              (setq mode (mode (mode-permissions mode))
                    ensure :present)
              (return (values* #1#))))
          (properties* (ensure . #1#)))))
  

Download