├── .gitignore ├── LICENSE.txt ├── README.md ├── cl-diskspace.asd └── src ├── common.lisp ├── packages.lisp ├── unix ├── cl-diskspace-list-all-disks-with-df.lisp ├── cl-diskspace-statvfs.lisp └── grovel-statvfs.lisp ├── utils.lisp └── win32 ├── cl-diskspace-get-disk-free-space.lisp ├── cl-diskspace-get-logical-drives.lisp └── cl-diskspace-load-foreign-library.lisp /.gitignore: -------------------------------------------------------------------------------- 1 | .DS_Store 2 | -------------------------------------------------------------------------------- /LICENSE.txt: -------------------------------------------------------------------------------- 1 | Copyright (c) 2015 Muyinliu Xing 2 | 3 | Permission to use, copy, modify, and distribute this software for any 4 | purpose with or without fee is hereby granted, provided that the above 5 | copyright notice and this permission notice appear in all copies. 6 | 7 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 8 | WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 9 | MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 10 | ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 11 | WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 12 | ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 13 | OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 14 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # cl-diskspace 2 | 3 | cl-diskspace is a Common Lisp feature to list disks with command line tool `df`(Linux/Mac) or `GetLogicalDrives`(Windows), and get disk space information using `statvfs`(Unix/Linux/Mac) or `GetDiskFreeSpace`(Windows), supports Unix/Linux/Mac/Windows. 4 | 5 | 6 | ## License 7 | 8 | Copyright (c) 2015 Muyinliu Xing 9 | Released under the ISC License. 10 | 11 | ## Compatibility 12 | 13 | | Common Lisp | Linux | Mac | Unix | Windows | 14 | |---------------|:-------:|:----:|:-----:|:-------:| 15 | | SBCL | Yes | Yes | | Yes | 16 | 17 | Note: I don't have Unix system so haven't test on Unix yet. 18 | 19 | Note: Have test in Windows XP/Windows 7/Windows 8.1/Windows 10 20 | 21 | Note: Welcome to reply test results in other Common Lisp implements. 22 | 23 | ## Install and load with QuickLisp 24 | 25 | In shell: 26 | ```shell 27 | git clone https://github.com/muyinliu/cl-diskspace.git 28 | cp -r cl-diskspace ~/quicklisp/local-projects/ 29 | ``` 30 | In Common Lisp: 31 | ```lisp 32 | (ql:quickload 'cl-diskspace) 33 | ``` 34 | 35 | ## Usage 36 | 37 | ### List all disks 38 | 39 | ```lisp 40 | (diskspace:list-all-disks) 41 | ``` 42 | Will get something like this: 43 | ```=> 44 | ("/" "/Volumes/Seagate1T") 45 | ``` 46 | Note: result in Mac 47 | 48 | ```lisp 49 | (diskspace:list-all-disks) 50 | ``` 51 | Will get something like this: 52 | ```=> 53 | ("C:\\" "D:\\") 54 | ``` 55 | Note: result in Windows 56 | 57 | ### Get all disk space information 58 | 59 | ```lisp 60 | (diskspace:list-all-disk-info) 61 | ``` 62 | Will get something like this: 63 | ```=> 64 | ((:DISK "/" :TOTAL 127175917568 :FREE 16509661184 :AVAILABLE 65 | 16247517184 :USE-PERCENT 87)) 66 | ``` 67 | 68 | ### Get all disk space information in human-readable 69 | 70 | ```lisp 71 | (diskspace:list-all-disk-info t) 72 | ``` 73 | Will get something like this: 74 | ```=> 75 | ((:DISK "/" :TOTAL "118.44G" :FREE "15.38G" :AVAILABLE 76 | "15.13G" :USE-PERCENT 87)) 77 | ``` 78 | 79 | ### Get disk space information 80 | 81 | ```lisp 82 | (diskspace:disk-space "/") 83 | ``` 84 | Will get something like this: 85 | ``` 86 | 127175917568 87 | 16509661184 88 | 16247517184 89 | ``` 90 | Note: the total space is 118.44G, free space is 15.38G and available space is 15.13G 91 | 92 | ### Get disk space information in human-readable 93 | 94 | ```lisp 95 | (diskspace:disk-space "/" t) 96 | ``` 97 | Will get something like this: 98 | ``` 99 | "118.44G" 100 | "15.38G" 101 | "15.13G" 102 | ``` 103 | 104 | ### Get disk total space 105 | 106 | ```lisp 107 | (diskspace:disk-total-space "/") 108 | ``` 109 | Will get something like this: 110 | ``` 111 | 127175917568 112 | ``` 113 | 114 | ### Get disk total space in human-readable 115 | 116 | ```lisp 117 | (diskspace:disk-total-space "/" t) 118 | ``` 119 | Will get something like this: 120 | ``` 121 | "118.4G" 122 | ``` 123 | 124 | ### Get disk free space 125 | 126 | ```lisp 127 | (diskspace:disk-free-space "/") 128 | ``` 129 | Will get something like this: 130 | ``` 131 | 16509661184 132 | ``` 133 | 134 | ### Get disk free space in human-readable 135 | 136 | ```lisp 137 | (diskspace:disk-free-space "/" t) 138 | ``` 139 | Will get something like this: 140 | ``` 141 | "15.38G" 142 | ``` 143 | 144 | ### Get disk available space 145 | 146 | ```lisp 147 | (diskspace:disk-available-space "/") 148 | ``` 149 | Will get something like this: 150 | ``` 151 | 16247517184 152 | ``` 153 | 154 | ### Get disk available space in human-readable 155 | 156 | ```lisp 157 | (diskspace:disk-available-space "/" t) 158 | ``` 159 | Will get something like this: 160 | ``` 161 | "15.13G" 162 | ``` 163 | -------------------------------------------------------------------------------- /cl-diskspace.asd: -------------------------------------------------------------------------------- 1 | ;;;; cl-diskspace.asd 2 | 3 | (asdf:defsystem "cl-diskspace" 4 | :name "diskspace" 5 | :description "List disks, get disk total/free/usable space information." 6 | :version "0.3.1" 7 | :author "Muyinliu Xing " 8 | :license "ISC" 9 | :defsystem-depends-on ("cffi-grovel") 10 | :depends-on ("cffi" 11 | #+(or bsd freebsd linux) 12 | "cl-ppcre" 13 | "uiop") 14 | :serial t 15 | :components 16 | ((:module "src" 17 | :serial t 18 | :components 19 | ((:file "packages") 20 | (:file "utils") 21 | #+(or bsd freebsd linux) 22 | (:module "unix" 23 | :serial t 24 | :components 25 | ((:cffi-grovel-file "grovel-statvfs") 26 | (:file "cl-diskspace-list-all-disks-with-df") 27 | (:file "cl-diskspace-statvfs"))) 28 | #+win32 29 | (:module "win32" 30 | :serial t 31 | :components 32 | ((:file "cl-diskspace-load-foreign-library") 33 | (:file "cl-diskspace-get-logical-drives") 34 | (:file "cl-diskspace-get-disk-free-space"))) 35 | (:file "common"))))) 36 | -------------------------------------------------------------------------------- /src/common.lisp: -------------------------------------------------------------------------------- 1 | ;;;; common.lisp 2 | 3 | (in-package #:cl-diskspace) 4 | 5 | (defun list-all-disk-info (&optional human-readable-p) 6 | "List disk information. example result: 7 | \(\(:DISK \"/\" :TOTAL 19993329664 :FREE 6154420224 :AVAILABLE 6154420224 8 | :USE-PERCENT 69) 9 | \(:DISK \"/mnt\" :TOTAL 21136445440 :FREE 2048335872 :AVAILABLE 974667776 10 | :USE-PERCENT 95)) 11 | 12 | \(\(:DISK \"/\" :TOTAL \"18.62 GB\" :FREE \"5.73 GB\" :AVAILABLE \"5.73 GB\" :USE-PERCENT 13 | 69) 14 | \(:DISK \"/mnt\" :TOTAL \"19.68 GB\" :FREE \"1.91 GB\" :AVAILABLE \"929.52 MB\" 15 | :USE-PERCENT 95))" 16 | (loop for disk in (list-all-disks) 17 | collect (multiple-value-bind (total free available) 18 | (disk-space disk) 19 | (if human-readable-p 20 | (list :disk disk 21 | :total (size-in-human-readable total) 22 | :free (size-in-human-readable free) 23 | :available (size-in-human-readable available) 24 | :use-percent (truncate (/ (* (- total available) 100) total))) 25 | (list :disk disk 26 | :total total 27 | :free free 28 | :available available 29 | :use-percent (truncate (/ (* (- total available) 100) total))))))) 30 | -------------------------------------------------------------------------------- /src/packages.lisp: -------------------------------------------------------------------------------- 1 | ;;;; packages.lisp 2 | 3 | (defpackage #:cl-diskspace 4 | (:use #:cl 5 | #:cffi 6 | #:cffi-grovel) 7 | (:nicknames :diskspace :ds) 8 | (:export #:list-all-disks 9 | #:list-all-disk-info 10 | #:disk-space 11 | #:disk-total-space 12 | #:disk-free-space 13 | #:disk-available-space 14 | #:size-in-human-readable)) 15 | -------------------------------------------------------------------------------- /src/unix/cl-diskspace-list-all-disks-with-df.lisp: -------------------------------------------------------------------------------- 1 | ;;;; cl-diskspace-list-all-disks-with-df.lisp 2 | 3 | (in-package :diskspace) 4 | 5 | #+(or linux bsd freebsd) 6 | (defun list-all-disks () 7 | "List all physical disk use command line tool df. note: size in KB." 8 | (let ((disk-info-string (with-output-to-string (stream) 9 | (uiop/run-program:run-program 10 | #+linux 11 | "/bin/df -P | grep ^/dev" 12 | #+bsd 13 | "/bin/df -k | grep ^/dev" 14 | :output stream)))) 15 | (loop for disk-info in (ppcre:split "\\n" disk-info-string) 16 | collect 17 | #+linux 18 | (ppcre:register-groups-bind (filesystem size used available use-percent mounted-on) 19 | ("^(.+)\\s+(\\d+)\\s+(\\d+)\\s+(\\d+)\\s+(\\d+)%\\s+(.+)$" 20 | disk-info) 21 | (declare (ignore filesystem size used available use-percent)) 22 | (string-trim '(#\Space) mounted-on)) 23 | ;; for Mac OS X 24 | #+bsd 25 | (ppcre:register-groups-bind (filesystem size used available use-percent 26 | iused ifree iuse-percent mounted-on) 27 | ("^(.+)\\s+(\\d+)\\s+(\\d+)\\s+(\\d+)\\s+(\\d+)%\\s+(\\d+)\\s+(\\d+)\\s+(\\d+)%\\s+(.+)$" 28 | disk-info) 29 | (declare (ignore filesystem size used available use-percent 30 | iused ifree iuse-percent)) 31 | (string-trim '(#\Space) mounted-on))))) 32 | -------------------------------------------------------------------------------- /src/unix/cl-diskspace-statvfs.lisp: -------------------------------------------------------------------------------- 1 | ;;;; cl-diskinfo-statvfs.lisp 2 | 3 | (in-package #:cl-diskspace) 4 | 5 | ;; int statvfs(const char *path, struct statvfs *buf); 6 | (defcfun ("statvfs" %statvfs) 7 | :int 8 | (path :string) 9 | (buf :pointer)) 10 | 11 | ;;;; sys/statvfs.h 12 | 13 | (defun statvfs (path) 14 | (with-foreign-object (buf '(:struct statvfs)) 15 | (%statvfs path buf) 16 | (with-foreign-slots ((bsize frsize blocks bfree bavail files 17 | ffree favail fsig flag namemax) 18 | buf 19 | (:struct statvfs)) 20 | (values bsize frsize blocks bfree bavail files 21 | ffree favail fsig flag namemax)))) 22 | 23 | ;;;; High level APIs 24 | 25 | (defun disk-space (path &optional human-readable-p) 26 | "Disk space information include total/free/available space." 27 | (multiple-value-bind (bsize frsize blocks bfree bavail files 28 | ffree favail fsig flag namemax) 29 | (statvfs path) 30 | (declare (ignore bsize files ffree favail fsig flag namemax)) 31 | (if human-readable-p 32 | (values (size-in-human-readable (* frsize blocks)) 33 | (size-in-human-readable (* frsize bfree)) 34 | (size-in-human-readable (* frsize bavail))) 35 | (values (* frsize blocks) (* frsize bfree) (* frsize bavail))))) 36 | 37 | (defun disk-total-space (path &optional human-readable-p) 38 | "Disk total space." 39 | (multiple-value-bind (bsize frsize blocks bfree bavail files 40 | ffree favail fsig flag namemax) 41 | (statvfs path) 42 | (declare (ignore bsize bfree bavail files ffree favail fsig flag namemax)) 43 | (if human-readable-p 44 | (size-in-human-readable (* frsize blocks)) 45 | (* frsize blocks)))) 46 | 47 | (defun disk-free-space (path &optional human-readable-p) 48 | "Disk free space." 49 | (multiple-value-bind (bsize frsize blocks bfree bavail files 50 | ffree favail fsig flag namemax) 51 | (statvfs path) 52 | (declare (ignore bsize blocks bavail files ffree favail fsig flag namemax)) 53 | (if human-readable-p 54 | (size-in-human-readable (* frsize bfree)) 55 | (* frsize bfree)))) 56 | 57 | (defun disk-available-space (path &optional human-readable-p) 58 | "Disk available space." 59 | (multiple-value-bind (bsize frsize blocks bfree bavail files 60 | ffree favail fsig flag namemax) 61 | (statvfs path) 62 | (declare (ignore bsize blocks bfree files ffree favail fsig flag namemax)) 63 | (if human-readable-p 64 | (size-in-human-readable (* frsize bavail)) 65 | (* frsize bavail)))) 66 | -------------------------------------------------------------------------------- /src/unix/grovel-statvfs.lisp: -------------------------------------------------------------------------------- 1 | ;;;; grovel-statvfs.lisp 2 | 3 | (in-package #:cl-diskspace) 4 | 5 | (cc-flags "-I/usr/include") 6 | 7 | (include "sys/statvfs.h") 8 | 9 | ;;; from sys/statvfs.h (/usr/include/sys/statvfs.h) 10 | ;; struct statvfs { 11 | ;; unsigned long f_bsize; /* filesystem block size */ 12 | ;; unsigned long f_frsize; /* fragment size */ 13 | ;; fsblkcnt_t f_blocks; /* size of fs in f_frsize units */ 14 | ;; fsblkcnt_t f_bfree; /* # free blocks */ 15 | ;; fsblkcnt_t f_bavail; /* # free blocks for unprivileged users */ 16 | ;; fsfilcnt_t f_files; /* # inodes */ 17 | ;; fsfilcnt_t f_ffree; /* # free inodes */ 18 | ;; fsfilcnt_t f_favail; /* # free inodes for unprivileged users */ 19 | ;; unsigned long f_fsid; /* filesystem ID */ 20 | ;; unsigned long f_flag; /* mount flags */ 21 | ;; unsigned long f_namemax; /* maximum filename length */ 22 | ;; }; 23 | 24 | (ctype fsblkcnt "fsblkcnt_t") 25 | (ctype fsfilcnt "fsfilcnt_t") 26 | 27 | (cstruct statvfs "struct statvfs" 28 | (bsize "f_bsize" :type :unsigned-long) 29 | (frsize "f_frsize" :type :unsigned-long) 30 | (blocks "f_blocks" :type fsblkcnt) 31 | (bfree "f_bfree" :type fsblkcnt) 32 | (bavail "f_bavail" :type fsblkcnt) 33 | (files "f_files" :type fsfilcnt) 34 | (ffree "f_ffree" :type fsfilcnt) 35 | (favail "f_favail" :type fsfilcnt) 36 | (fsig "f_fsid" :type :unsigned-long) 37 | (flag "f_flag" :type :unsigned-long) 38 | (namemax "f_namemax" :type :unsigned-long)) 39 | 40 | (constant (st-rdonly "ST_RDONLY")) 41 | (constant (st-nosuid "ST_NOSUID")) 42 | -------------------------------------------------------------------------------- /src/utils.lisp: -------------------------------------------------------------------------------- 1 | ;;;; utils.lisp 2 | 3 | (in-package #:cl-diskspace) 4 | 5 | (defun size-in-human-readable (number) 6 | (check-type number integer) 7 | (loop for size in '(80 70 60 50 40 30 20 10) 8 | and unit in '("YB" "ZB" "EB" "PB" "TB" "GB" "MB" "KB") 9 | when (> (ash number (- size)) 0) 10 | do (return-from size-in-human-readable 11 | (format nil "~,2F ~A" 12 | (float (/ number (ash 1 size))) 13 | unit)))) 14 | -------------------------------------------------------------------------------- /src/win32/cl-diskspace-get-disk-free-space.lisp: -------------------------------------------------------------------------------- 1 | ;;;; cl-diskspace-get-disk-free-space-ex.lisp 2 | 3 | (in-package :diskspace) 4 | 5 | ;; C++ Syntax from https://msdn.microsoft.com/en-us/library/windows/desktop/aa364935(v=vs.85).aspx 6 | ;; BOOL WINAPI GetDiskFreeSpace( 7 | ;; _In_ LPCTSTR lpRootPathName, 8 | ;; _Out_ LPDWORD lpSectorsPerCluster, 9 | ;; _Out_ LPDWORD lpBytesPerSector, 10 | ;; _Out_ LPDWORD lpNumberOfFreeClusters, 11 | ;; _Out_ LPDWORD lpTotalNumberOfClusters 12 | ;; ); 13 | 14 | (defcfun ("GetDiskFreeSpaceA" %GetDiskFreeSpace) 15 | :boolean 16 | (lpRootPathName :string) 17 | (lpSectorsPerCluster :pointer) 18 | (lpBytesPerSector :pointer) 19 | (lpNumberOfFreeClusters :pointer) 20 | (lpTotalNumberOfClusters :pointer)) 21 | 22 | (defun GetDiskFreeSpace (path) 23 | (with-foreign-string (lpRootPathName path) 24 | (with-foreign-pointer (lpSectorsPerCluster 32) 25 | (with-foreign-pointer (lpBytesPerSector 32) 26 | (with-foreign-pointer (lpNumberOfFreeClusters 32) 27 | (with-foreign-pointer (lpTotalNumberOfClusters 32) 28 | (funcall #'%GetDiskFreeSpace lpRootPathName lpSectorsPerCluster 29 | lpBytesPerSector lpNumberOfFreeClusters lpTotalNumberOfClusters) 30 | (values (mem-ref lpSectorsPerCluster :int) 31 | (mem-ref lpBytesPerSector :int) 32 | (mem-ref lpNumberOfFreeClusters :int) 33 | (mem-ref lpTotalNumberOfClusters :int)))))))) 34 | 35 | ;;; High level API 36 | 37 | (defun disk-space (path &optional human-readable-p) 38 | "Disk space information include total/free/available space." 39 | (multiple-value-bind (sectorsPerCluster bytesPerSector numberOfFreeClusters 40 | totalNumberOfClusters) 41 | (GetDiskFreeSpace path) 42 | (if human-readable-p 43 | (values (size-in-human-readable (* sectorsPerCluster 44 | bytesPerSector 45 | totalNumberOfClusters)) 46 | (size-in-human-readable (* sectorsPerCluster 47 | bytesPerSector 48 | numberOfFreeClusters)) 49 | (size-in-human-readable (* sectorsPerCluster 50 | bytesPerSector 51 | numberOfFreeClusters))) 52 | (values (* sectorsPerCluster bytesPerSector totalNumberOfClusters) 53 | (* sectorsPerCluster bytesPerSector numberOfFreeClusters) 54 | (* sectorsPerCluster bytesPerSector numberOfFreeClusters))))) 55 | 56 | (defun disk-total-space (path &optional human-readable-p) 57 | (multiple-value-bind (sectorsPerCluster bytesPerSector numberOfFreeClusters 58 | totalNumberOfClusters) 59 | (GetDiskFreeSpace path) 60 | (if human-readable-p 61 | (size-in-human-readable (* sectorsPerCluster bytesPerSector totalNumberOfClusters)) 62 | (* sectorsPerCluster bytesPerSector totalNumberOfClusters)))) 63 | 64 | (defun disk-free-space (path &optional human-readable-p) 65 | (multiple-value-bind (sectorsPerCluster bytesPerSector numberOfFreeClusters 66 | totalNumberOfClusters) 67 | (GetDiskFreeSpace path) 68 | (if human-readable-p 69 | (size-in-human-readable (* sectorsPerCluster bytesPerSector numberOfFreeClusters)) 70 | (* sectorsPerCluster bytesPerSector numberOfFreeClusters)))) 71 | 72 | (defun disk-available-space (path &optional human-readable-p) 73 | (multiple-value-bind (sectorsPerCluster bytesPerSector numberOfFreeClusters 74 | totalNumberOfClusters) 75 | (GetDiskFreeSpace path) 76 | (if human-readable-p 77 | (size-in-human-readable (* sectorsPerCluster bytesPerSector numberOfFreeClusters)) 78 | (* sectorsPerCluster bytesPerSector numberOfFreeClusters)))) 79 | -------------------------------------------------------------------------------- /src/win32/cl-diskspace-get-logical-drives.lisp: -------------------------------------------------------------------------------- 1 | ;;;; cl-diskspace-get-logical-drives.lisp 2 | 3 | (in-package :diskspace) 4 | 5 | ;; C++ Syntax from https://msdn.microsoft.com/en-us/library/windows/desktop/aa364972(v=vs.85).aspx 6 | ;; DWORD WINAPI GetLogicalDrives(void); 7 | ;; Return value 8 | ;; If the function succeeds, the return value is a bitmask representing the currently available disk drives. Bit position 0 (the least-significant bit) is drive A, bit position 1 is drive B, bit position 2 is drive C, and so on. 9 | ;; If the function fails, the return value is zero. To get extended error information, call GetLastError. 10 | (defcfun ("GetLogicalDrives" %GetLogicalDrives) 11 | :int) 12 | 13 | (defun GetLogicalDrives () 14 | "Get logical drivers, return example: (\"C:\\\" \"D:\\\" \"W:\\\" \"Y:\\\" \"Z:\\\")." 15 | (let ((number (funcall #'%GetLogicalDrives)) 16 | drive-list) 17 | (do ((index 0 (+ index 1))) 18 | ((<= (ash number (- index)) 0)) 19 | (when (equal 1 (logand (ash number (- index)) 1)) 20 | (push (format nil "~A:\\" (code-char (+ 65 index))) drive-list))) 21 | (reverse drive-list))) 22 | 23 | (defun list-all-disks () 24 | "List all logical drivers, return example: (\"C:\\\" \"D:\\\" \"W:\\\" \"Y:\\\" \"Z:\\\")." 25 | (GetLogicalDrives)) 26 | -------------------------------------------------------------------------------- /src/win32/cl-diskspace-load-foreign-library.lisp: -------------------------------------------------------------------------------- 1 | ;;;; cl-diskspace-load-foreign-library.lisp 2 | 3 | (in-package :diskspace) 4 | 5 | (define-foreign-library kernel32 6 | (:windows "C:/WINDOWS/system32/kernel32.dll")) 7 | 8 | (use-foreign-library kernel32) 9 | 10 | --------------------------------------------------------------------------------