/pliant/linux/storage/filesystem.pli
 
 1  abstract 
 2    [This module will give you the ability to deal with Linux disk related features (mounting, umounting and querying a partition).] 
 3   
 4   
 5  # Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx 
 6  # 
 7  # This program is free software; you can redistribute it and/or 
 8  # modify it under the terms of the GNU General Public License version 2 
 9  # as published by the Free Software Foundation. 
 10  # 
 11  # This program is distributed in the hope that it will be useful, 
 12  # but WITHOUT ANY WARRANTY; without even the implied warranty of 
 13  # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the 
 14  # GNU General Public License for more details. 
 15  # 
 16  # You should have received a copy of the GNU General Public License 
 17  # version 2 along with this program; if not, write to the Free Software 
 18  # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA. 
 19   
 20  module "/pliant/language/os.pli" 
 21  module "/pliant/language/stream.pli" 
 22  module "/pliant/admin/file.pli" 
 23  module "/pliant/admin/execute.pli" 
 24  module "/pliant/linux/kernel/device.pli" 
 25   
 26  if os_api<>"linux" 
 27    error error_id_missing "This module works only with Linux" 
 28   
 29  constant trace false 
 30   
 31   
 32 
 
 33   
 34   
 35  function os_mount dev dir fs flags opt -> err 
 36    arg CStr dev dir fs ; arg Int flags ; arg CStr opt ; arg Int err 
 37    kernel_function 21 
 38   
 39  function os_umount name flags -> err 
 40    arg CStr name ; arg Int flags err 
 41    kernel_function 52 
 42   
 43   
 44  type os_statfs 
 45    field uInt type 
 46    field uInt bsize 
 47    field uInt blocks 
 48    field uInt bfree 
 49    field uInt bavail 
 50    field uInt bfiles 
 51    field uInt ffree 
 52    field (Array uInt 2) fsid 
 53    field uInt namelen 
 54    field (Array uInt 6) spare 
 55    
 56  function os_statfs path buf -> err 
 57    arg CStr path ; arg_w os_statfs buf ; arg Int err 
 58    kernel_function 99 
 59   
 60     
 61 
 
 62   
 63   
 64  doc 
 65    ['filesystem_name' works only for EXT2 partitions, and will return the volume name of the partition] 
 66    [ (you can also get it using 'tune2fs -l' Unix command).] 
 67   
 68   
 69  function filesystem_study device fs label 
 70    arg Str device ; arg_w Str fs label 
 71    fs := "" ; label := "" 
 72    var Stream dev ; dev open device in+safe 
 73    if dev=failure 
 74      return 
 75    part ext2 
 76      dev configure "seek "+string:438h 
 77      var uInt16 sign2 ; dev raw_read addressof:sign2 uInt16:size 
 78      if sign2=0EF53h 
 79        dev configure "seek "+(string 1024+224) 
 80        dev raw_read addressof:(var uInt32 journal) uInt32:size 
 81        fs := shunt journal="ext2" "ext3" 
 82        dev configure "seek "+string:478h 
 83        for (var Int i) 1 16 
 84          var Char c ; dev raw_read addressof:Char:size 
 85          if c:number=0 
 86            return 
 87          else 
 88            label += c 
 89        return 
 90    part xfs 
 91      dev configure "seek 0" 
 92      var uInt32_hi sign4 ; dev raw_read addressof:sign4 uInt32_hi:size 
 93      if sign4=58465342h 
 94        fs := "xfs" 
 95        dev configure "seek 108" 
 96        for (var Int i) 1 12 
 97          var Char c ; dev raw_read addressof:Char:size 
 98          if c:number=0 
 99            return 
 100          else 
 101            label += c 
 102        return 
 103    part iso9660 
 104      dev configure "seek "+(string 16*2048) 
 105      var Str sign := repeat " " ; dev raw_read sign:characters sign:len 
 106      if sign=character:1+"CD001"+character:1+"[0]" # ISO9660 
 107        fs := "iso9660" 
 108        label := repeat 32 " " 
 109        dev raw_read label:characters label:len 
 110        dev raw_read label:characters label:len 
 111        while label:len>and (label label:len-1)=" " 
 112          label := label label:len-1 
 113        label := label 0 (label search "[0]" label:len) 
 114        return 
 115   
 116  function filesystem_filesystem device -> fs 
 117    arg Str device fs 
 118    filesystem_study device fs (var Str label) 
 119   
 120  function filesystem_name device -> label 
 121    arg Str device label 
 122    filesystem_study device (var Str fs) label 
 123   
 124  function filesystem_bus device -> bus 
 125    arg Str device bus 
 126    bus := "" 
 127    if (file_os_name:device eparse "/dev/" any:(var Str dev)) 
 128      var FileInfo info := file_query "file:/sys/block/"+dev+"/device" extended 
 129      var Str link := info:options option "link" Str 
 130      if (link eparse "../../devices/" any:(var Str remain)) 
 131        link := remain 
 132      while (link eparse any:(var Str first) "/" any:(var Str remain)) and (first search ":" -1)<>(-1) 
 133        link := remain 
 134      if (link eparse any:(var Str first) "/" any) 
 135        if (first eparse any:(var Str s) (var Int i)) 
 136          bus := s 
 137   
 138  doc 
 139    ['filesystem_scan' will call 'filesystem_name' on all standard Linux disks and partitions in order to build a mapping volume_name -> device so that you can later use 'filesystem_mount' function specifying the volume name instead of the device.] 
 140   
 141  gvar Dictionary partitions 
 142   
 143  function filesystem_scan 
 144    partitions := var Dictionary empty 
 145    for (var Int i) 0 1 
 146      for (var Int p) 0 4 
 147        for (var Int d) 0 25 
 148          var Str device := "device:/"+(shunt i="h" "s")+"d"+(character "a":0:number+d)+(shunt p<>string:"") 
 149          if trace 
 150            console "scanning "+device+"[cr]" 
 151          var Str name := filesystem_name device 
 152          if name<>"" 
 153            partitions insert name true addressof:(new Str device) 
 154            if trace 
 155              console "found partition "+name+" on "+device+"[lf]" 
 156    if trace 
 157      console (repeat 40 " ")+"[lf]" 
 158   
 159   
 160 
 
 161   
 162   
 163  doc 
 164    ['filesystem_query' will will return the total size and still available space on a mounted partition which MUST be specifyed by it's mount point.] 
 165   
 166  public 
 167    type DiskInfo 
 168      field Intn size 
 169      field Intn available 
 170     
 171  function filesystem_query path -> info 
 172    arg Str path ; arg DiskInfo info 
 173    info size := undefined 
 174    info available := undefined 
 175    if (path parse "device:/" any:(var Str name)) 
 176      (var Stream s) open "file:/proc/partitions" in+safe 
 177      while not s:atend 
 178        if (s:readline parse (var Int major) (var Int minor) (var uInt blocs) pattern:name) 
 179          info size := blocs*1024n 
 180    else 
 181      if (os_statfs file_os_name:path (var os_statfs buf))=0 
 182        info size := buf:blocks*(cast buf:bsize Intn) 
 183        info available := buf:bavail*(cast buf:bsize Intn) 
 184   
 185   
 186  function filesystem_is_mounted spec -> mounted 
 187    arg Str spec ; arg CBool mounted 
 188    var Str os_spec := file_os_name spec 
 189    (var Stream m) open "file:/proc/mounts" in+safe 
 190    while not m:atend 
 191      if (m:readline eparse any:(var Str dev) _ any:(var Str path) _ any) 
 192        if os_spec=dev or os_spec=path or os_spec=path+"/" 
 193          return true 
 194    mounted := false 
 195   
 196   
 197  function filesystem_dev_mount dev path fs options -> status 
 198    arg Str dev path fs options ; arg Status status 
 199    var Str extra := options option "linux_options" Str 
 200    var Int err := os_mount file_os_name:dev file_os_name:path fs 0C0ED0000h+(shunt (options option "readonly") 1 0)+(shunt (options option "remount") 32 0)+(shunt (options option "read_datetime") 0 1024+2048) extra 
 201    if true # trace 
 202      console "mounting " file_os_name:dev " at " file_os_name:path " with filesystem " fs " and options " extra " -> " err eol 
 203    status := shunt err=0 success failure 
 204   
 205  function filesystem_dev_dismount name options -> status 
 206    arg Str name options ; arg Status status 
 207    var Int err := os_umount file_os_name:name (shunt (options option "force") 1 0)+(shunt (options option "lazy") 2 0) 
 208    status := shunt err=0 success failure 
 209     
 210   
 211  doc 
 212    ['filesystem_mount' will mount a partition either provided by it's volume name ('disk_scan' must have been called once previously) or by it's device name.] ; eol 
 213    [The possible options are:] 
 214    list 
 215      item 
 216        fixed [filesystem [dq]] ; italic [name]; fixed [[dq]] [ defines the kind of filesystem to be mounted (default is [dq]ext2[dq])] 
 217      item 
 218        fixed [check ] [ will force to e2fsck the partition] 
 219      item 
 220        fixed [nocheck ] [ will not e2fsck the partition] 
 221      item 
 222        fixed [tune ] [ will set the options I like for a data storage partition (remount read only in case of failure and only 1MB reserved for root)] 
 223      item 
 224        fixed [readonly ] [ mounts the partition read only] 
 225    [If none of 'check' and 'nocheck' is specifyed, check if required is applyed (not properly umounted, or mounted many times since last check, or not checked for many many days partition).] 
 226   
 227  function filesystem_mount name path options -> status 
 228    arg Str name path options ; arg Status status 
 229    var Str device 
 230    if file_os_name:name<>"" 
 231      device := name 
 232    eif { var Pointer:Arrow :> partitions first name ; a<>null } 
 233      device := map Str 
 234    else 
 235      return failure 
 236    if (file_query device standard)=undefined 
 237      kernel_make_device device 
 238    var Str fs := options option "filesystem" Str 
 239    if fs="" 
 240      fs := filesystem_filesystem device 
 241    if not (options option "nocheck"and (fs="ext2" or fs="ext3"and not filesystem_is_mounted:path 
 242      var Int err := execute "e2fsck -y"+(shunt (options option "check"" -f" "")+(shunt (options option "surface"" -c" "")+" "+file_os_name:device quiet 
 243      if err<>0 
 244        console "Failed to check " device " partition (error code is " err ") ... retrying in verbose mode." eol 
 245        err := execute "e2fsck -y"+(shunt (options option "check"" -f" "")+" "+file_os_name:device mixed 
 246        if err<>0 
 247          console "Failed to check " device " partition !  (error code is " err ")" eol 
 248    if (options option "check"and fs="xfs" and not filesystem_is_mounted:path 
 249      var Int err := execute "xfs_repair "+file_os_name:device mixed 
 250      if err<>0 
 251        console "Failed to repair " device " partition !  (error code is " err ")" eol 
 252    if (options option "tune") 
 253      execute "tune2fs -e remount-ro -r 1024 "+device quiet 
 254    file_tree_create path 
 255    status := filesystem_dev_mount device path fs options 
 256   
 257   
 258  doc 
 259    ['filesystem_dismount' will umount a partition either specifyed by it's volume name, it's device name or it's mount path.] 
 260   
 261  function filesystem_dismount name options -> status 
 262    arg Str name options ; arg Status status 
 263    var Str device 
 264    if file_os_name:name<>"" 
 265      device := name 
 266    eif { var Pointer:Arrow :> partitions first name ; a<>null } 
 267      device := map Str 
 268    else 
 269      return failure 
 270    status := filesystem_dev_dismount device options 
 271     
 272  function filesystem_dismount name -> status 
 273    arg Str name ; arg Status status 
 274    status := filesystem_dismount name "" 
 275   
 276   
 277 
 
 278   
 279   
 280  export filesystem_filesystem filesystem_name filesystem_bus 
 281  export filesystem_scan filesystem_mount filesystem_dismount filesystem_query filesystem_is_mounted