liminix

Unnamed repository; edit this file 'description' to name the repository.
Log | Files | Refs | README | LICENSE

fs.fnl (2392B)

      1 (local ll (require :lualinux))
      2 (import-macros { :  define-tests : expect : expect= } :anoia.assert)
      3 
      4 (local S_IFMT   0xf000)
      5 (local S_IFSOCK 0xc000)
      6 (local S_IFLNK  0xa000)
      7 (local S_IFREG  0x8000)
      8 (local S_IFBLK  0x6000)
      9 (local S_IFDIR  0x4000)
     10 (local S_IFCHR  0x2000)
     11 (local S_IFIFO  0x1000)
     12 
     13 (macro errno-check [x]
     14   `(match ,x
     15      val# val#
     16      (nil errno#) (assert nil (.. "system call failed, errno=" errno#))
     17      ))
     18 
     19 (fn ifmt-bits [mode] (and mode (band mode 0xf000)))
     20 
     21 (fn file-type [pathname]
     22   (. {
     23       S_IFDIR :directory
     24       S_IFSOCK :socket
     25       S_IFLNK :link
     26       S_IFREG :file
     27       S_IFBLK :block-device
     28       S_IFCHR :character-device
     29       S_IFIFO :fifo
     30       }
     31      (ifmt-bits (ll.lstat3 pathname))))
     32 
     33 (fn directory? [pathname]
     34   (= (file-type pathname) :directory))
     35 
     36 (fn mktree [pathname]
     37   (if (or (= pathname "") (= pathname "/"))
     38       (error (.. "can't mkdir " pathname)))
     39 
     40   (or (directory? pathname)
     41       (let [parent (string.gsub pathname "/[^/]+/?$" "")]
     42         (or (directory? parent) (mktree parent))
     43         (errno-check (ll.mkdir pathname)))))
     44 
     45 (fn dir [name]
     46   (let [dp (errno-check (ll.opendir name) name)]
     47     (fn []
     48       (case (ll.readdir dp)
     49         (name filetype) (values name filetype)
     50         (nil err) (do (if (> err 0) (print "ERR" err)) (ll.closedir dp) nil)
     51         ))))
     52 
     53 (fn rmtree [pathname]
     54   (case (file-type pathname)
     55     nil true
     56     :directory
     57     (do
     58       (each [f (dir pathname)]
     59         (when (not (or (= f ".") (= f "..")))
     60           (rmtree ( .. pathname "/" f)))
     61         (ll.rmdir pathname)))
     62     :file
     63     (os.remove pathname)
     64     :link
     65     (os.remove pathname)
     66     unknown
     67     (error (.. "can't remove " pathname " of mode \"" unknown "\""))))
     68 
     69 ;; lualinux doesn't publish access(2), this is not exactly
     70 ;; the same but will suffice until we can add it
     71 (fn executable? [f]
     72   (let [statbuf {}
     73         stat (ll.lstat f statbuf 1)]
     74     (and stat (> (band (. stat 3) 73) 0)))) ; \0111
     75 
     76 (fn find-executable [exe search-path]
     77   (accumulate [full-path nil
     78                p (string.gmatch search-path "(.-):")]
     79     (or full-path (let [f (.. p "/" exe)] (and (executable? f) f)))))
     80 
     81 (define-tests
     82   (let [p (find-executable "yes" (os.getenv "PATH"))]
     83     (expect (string.match p "coreutils.+bin/yes$"))))
     84 
     85 {
     86  : mktree
     87  : rmtree
     88  : directory?
     89  : dir
     90  : file-type
     91  : find-executable
     92  :symlink (fn [from to] (ll.symlink from to))
     93  }