Patch title: Release 92 bulk changes
Abstract:
File: /linux/storage/filesystem.pli
Key:
    Removed line
    Added line
abstract
  [This module will give you the ability to deal with Linux disk related features (mounting, umounting and querying a partition).]


# Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License version 2
# as published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# version 2 along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.

module "/pliant/language/os.pli"
module "/pliant/language/stream.pli"
module "/pliant/admin/file.pli"
module "/pliant/admin/execute.pli"
module "/pliant/linux/kernel/device.pli"

if os_api<>"linux"
  error error_id_missing "This module works only with Linux"

constant trace false


#-------------------------------------------------------------------------


function os_mount dev dir fs flags opt -> err
  arg CStr dev dir fs ; arg Int flags ; arg CStr opt ; arg Int err
  kernel_function 21

function os_umount name -> err
  arg CStr name ; arg Int err
  kernel_function 22


type os_statfs
  field uInt type
  field uInt bsize
  field uInt blocks
  field uInt bfree
  field uInt bavail
  field uInt bfiles
  field uInt ffree
  field (Array uInt 2) fsid
  field uInt namelen
  field (Array uInt 6) spare
 
function os_statfs path buf -> err
  arg CStr path ; arg_w os_statfs buf ; arg Int err
  kernel_function 99

  
#-------------------------------------------------------------------------


doc
  ['filesystem_name' works only for EXT2 partitions, and will return the volume name of the partition]
  [ (you can also get it using 'tune2fs -l' Unix command).]


function filesystem_name device -> name
  arg Str device name
  name := ""
function filesystem_study device fs label
  arg Str device ; arg_w Str fs label
  fs := "" ; label := ""
  var Stream dev ; dev open device in+safe
  if dev=failure
    return
  dev configure "seek "+string:438h
  var uInt16 sign2 ; dev raw_read addressof:sign2 uInt16:size
  if sign2=0EF53h # EXT2
    dev configure "seek "+string:478h
    for (var Int i) 1 256
      var Char c ; dev raw_read addressof:c Char:size
      if c:number=0
        return
      else
        name += c
    return
  dev configure "seek "+(string 16*2048)
  var Str sign := repeat 8 " " ; dev raw_read sign:characters sign:len
  console "sign is " sign eol
  if sign=character:1+"CD001"+character:1+"[0]" # ISO9660
    name := repeat 32 " "
    dev raw_read name:characters name:len
    dev raw_read name:characters name:len
    while name:len>0 and (name name:len-1)=" "
      name := name 0 name:len-1
    name := name 0 (name search "[0]" name:len)
    return
  name := ""
  part ext2
    dev configure "seek "+string:438h
    var uInt16 sign2 ; dev raw_read addressof:sign2 uInt16:size
    if sign2=0EF53h
      fs := "ext2"
      dev configure "seek "+string:478h
      for (var Int i) 1 256
        var Char c ; dev raw_read addressof:c Char:size
        if c:number=0
          return
        else
          label += c
      return
  part xfs
    dev configure "seek 0"
    var uInt32_hi sign4 ; dev raw_read addressof:sign4 uInt32_hi:size
    if sign4=58465342h
      fs := "xfs"
      dev configure "seek 108"
      for (var Int i) 1 12
        var Char c ; dev raw_read addressof:c Char:size
        if c:number=0
          return
        else
          label += c
      return
  part iso9660
    dev configure "seek "+(string 16*2048)
    var Str sign := repeat 8 " " ; dev raw_read sign:characters sign:len
    if sign=character:1+"CD001"+character:1+"[0]" # ISO9660
      fs := "iso9660"
      label := repeat 32 " "
      dev raw_read label:characters label:len
      dev raw_read label:characters label:len
      while label:len>0 and (label label:len-1)=" "
        label := label 0 label:len-1
      label := label 0 (label search "[0]" label:len)
      return

function filesystem_filesystem device -> fs
  arg Str device fs
  filesystem_study device fs (var Str label)

function filesystem_name device -> label
  arg Str device label
  filesystem_study device (var Str fs) label

doc
  ['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.]

gvar Dictionary partitions

function filesystem_scan
  partitions := var Dictionary empty
  for (var Int i) 0 1
    for (var Int p) 0 4
      for (var Int d) 0 25
        var Str device := "device:/"+(shunt i=0 "h" "s")+"d"+(character "a":0:number+d)+(shunt p<>0 string:p "")
        if trace
          console "scanning "+device+"[cr]"
        var Str name := filesystem_name device
        if name<>""
          partitions insert name true addressof:(new Str device)
          if trace
            console "found partition "+name+" on "+device+"[lf]"
  if trace
    console (repeat 40 " ")+"[lf]"


#-------------------------------------------------------------------------


doc
  ['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.]

public
  type DiskInfo
    field Intn size
    field Intn available
  
function filesystem_query path -> info
  arg Str path ; arg DiskInfo info
  info size := undefined
  info available := undefined
  if (path parse "device:/" any:(var Str name))
    (var Stream s) open "file:/proc/partitions" in+safe
    while not s:atend
      if (s:readline parse (var Int major) (var Int minor) (var uInt blocs) pattern:name)
        info size := blocs*1024n
  else
    if (os_statfs file_os_name:path (var os_statfs buf))=0
      info size := buf:blocks*(cast buf:bsize Intn)
      info available := buf:bavail*(cast buf:bsize Intn)


function filesystem_is_mounted spec -> mounted
  arg Str spec ; arg CBool mounted
  var Str os_spec := file_os_name spec
  (var Stream m) open "file:/proc/mounts" in+safe
  while not m:atend
    if (m:readline eparse any:(var Str dev) _ any:(var Str path) _ any)
      if os_spec=dev or os_spec=path or os_spec=path+"/"
        return true
  mounted := false


function filesystem_dev_mount dev path options -> status
  arg Str dev path options ; arg Status status
  var Str fs := options option "filesystem" Str "ext2"
function filesystem_dev_mount dev path fs options -> status
  arg Str dev path fs options ; arg Status status
  if trace
    console "mounting " file_os_name:dev " at " file_os_name:path " with filesystem " fs " and options " options eol
  var Str extra := options option "linux_options" Str
  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
  status := shunt err=0 success failure

function filesystem_dev_dismount name -> status
  arg Str name ; arg Status status
  var Int err := os_umount file_os_name:name
  status := shunt err=0 success failure
  

doc
  ['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
  [The possible options are:]
  list
    item
      fixed [filesystem [dq]] ; italic [name]; fixed [[dq]] ; [ defines the kind of filesystem to be mounted (default is [dq]ext2[dq])]
    item
      fixed [check ] ; [ will force to e2fsck the partition]
    item
      fixed [nocheck ] ; [ will not e2fsck the partition]
    item
      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)]
    item
      fixed [readonly ] ; [ mounts the partition read only]
  [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).]

function filesystem_mount name path options -> status
  arg Str name path options ; arg Status status
  var Str device
  if file_os_name:name<>""
    device := name
  eif { var Pointer:Arrow a :> partitions first name ; a<>null }
    device := a map Str
  else
    return failure
  if (file_query device standard)=undefined
    kernel_make_device device
  var Str fs := options option "filesystem" Str
  if not (options option "nocheck") and (fs="" or fs="ext2") and not filesystem_is_mounted:path
  if fs=""
    fs := filesystem_filesystem device
  if not (options option "nocheck") and fs="ext2" and not filesystem_is_mounted:path
    var Int err := execute "e2fsck -y"+(shunt (options option "check") " -f" "")+" "+file_os_name:device quiet
    if err<>0
      console "Failed to check " device " partition (error code is " err ") ... retrying in verbose mode." eol
      err := execute "e2fsck -y"+(shunt (options option "check") " -f" "")+" "+file_os_name:device mixed
      if err<>0
        console "Failed to check " device " partition !  (error code is " err ")" eol
  if (options option "check") and fs="xfs" and not filesystem_is_mounted:path
    var Int err := execute "xfs_repair "+file_os_name:device mixed
    if err<>0
      console "Failed to repair " device " partition !  (error code is " err ")" eol
  if (options option "tune")
    execute "tune2fs -e remount-ro -r 1024 "+device quiet
  file_tree_create path
  status := filesystem_dev_mount device path options
  status := filesystem_dev_mount device path fs options


doc
  ['filesystem_dismount' will umount a partition either specifyed by it's volume name, it's device name or it's mount path.]

function filesystem_dismount name -> status
  arg Str name ; arg Status status
  var Str device
  if file_os_name:name<>""
    device := name
  eif { var Pointer:Arrow a :> partitions first name ; a<>null }
    device := a map Str
  else
    return failure
  status := filesystem_dev_dismount device
  

#-------------------------------------------------------------------------


export filesystem_name
export filesystem_filesystem filesystem_name
export filesystem_scan filesystem_mount filesystem_dismount filesystem_query filesystem_is_mounted