liminix

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

fs.fnl (2790B)

      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 ;; returns nil if the pathname doesn't exist
     22 (fn file-type [pathname stat-flag]
     23   "symbol describing the file type of pathname as detected by lstat(2). Pass non-nil second arg to use stat(2) instead"
     24   (. {
     25       S_IFDIR :directory
     26       S_IFSOCK :socket
     27       S_IFLNK :link
     28       S_IFREG :file
     29       S_IFBLK :block-device
     30       S_IFCHR :character-device
     31       S_IFIFO :fifo
     32       }
     33      (ifmt-bits (ll.lstat3 pathname (if stat-flag 1)))))
     34 
     35 (fn directory? [pathname]
     36   (= (file-type pathname) :directory))
     37 
     38 (fn mktree [pathname]
     39   (if (or (= pathname "") (= pathname "/"))
     40       (error (.. "can't mkdir " pathname)))
     41 
     42   (case (file-type pathname :stat)
     43     :directory true
     44     ty (error (.. pathname " exists as " ty ", not a directory"))
     45     nil
     46     (let [parent (string.gsub pathname "/[^/]+/?$" "")]
     47       (or (= (file-type parent :stat) :directory) (mktree parent))
     48       (errno-check (ll.mkdir pathname)))))
     49 
     50 (fn dir [name]
     51   (let [dp (errno-check (ll.opendir name) name)]
     52     (fn []
     53       (case (ll.readdir dp)
     54         (name filetype) (values name filetype)
     55         (nil err) (do (if (> err 0) (print "ERR" err)) (ll.closedir dp) nil)
     56         ))))
     57 
     58 (fn rmtree [pathname]
     59   (case (file-type pathname)
     60     nil true
     61     :directory
     62     (do
     63       (each [f (dir pathname)]
     64         (when (not (or (= f ".") (= f "..")))
     65           (rmtree ( .. pathname "/" f)))
     66         (ll.rmdir pathname)))
     67     :file
     68     (os.remove pathname)
     69     :link
     70     (os.remove pathname)
     71     unknown
     72     (error (.. "can't remove " pathname " of mode \"" unknown "\""))))
     73 
     74 ;; lualinux doesn't publish access(2), this is not exactly
     75 ;; the same but will suffice until we can add it
     76 (fn executable? [f]
     77   (let [statbuf {}
     78         stat (ll.lstat f statbuf 1)]
     79     (and stat (> (band (. stat 3) 73) 0)))) ; \0111
     80 
     81 (fn find-executable [exe search-path]
     82   (accumulate [full-path nil
     83                p (string.gmatch search-path "(.-):")]
     84     (or full-path (let [f (.. p "/" exe)] (and (executable? f) f)))))
     85 
     86 (define-tests
     87   (let [p (find-executable "yes" (os.getenv "PATH"))]
     88     (expect (string.match p "coreutils.+bin/yes$"))))
     89 
     90 (define-tests
     91   (let [setup (os.execute "mkdir foo; ln -s foo bar")]
     92     (mktree "bar")))
     93 
     94 {
     95  : mktree
     96  : rmtree
     97  : directory?
     98  : dir
     99  : file-type
    100  : find-executable
    101  :symlink (fn [from to] (ll.symlink from to))
    102  }