/pliant/linux/storage/partition.pli
 
 1  module "/pliant/language/unsafe.pli" 
 2  module "/pliant/language/stream.pli" 
 3  module "/pliant/language/os.pli" 
 4  module "/pliant/admin/file.pli" 
 5  module "/pliant/admin/execute.pli" 
 6   
 7   
 8  constant fdisk false 
 9  constant trace false 
 10  constant recover true 
 11   
 12   
 13  doc 
 14    [ioctls are defined in /usr/src/linux/drivers/block/hd.c] 
 15   
 16   
 17  public 
 18    type DiskPartition 
 19      field Str name 
 20      field Str device 
 21      field Str raid_devices 
 22      field Str mountpoint 
 23      field Intn size <- 0 
 24      field Str filesystem 
 25      field Str options 
 26      if fdisk 
 27        field Int first_cylinder last_cylinder 
 28   
 29  function partition n d mp size fs o -> p 
 30    arg Str mp ; arg Intn size ; arg Str fs o ; arg DiskPartition p 
 31    name := n ; device := d ; mountpoint := mp ; size := size ; filesystem := fs ; options := o 
 32   
 33   
 34  if not fdisk 
 35   
 36    function get_disk_capacity disk -> size 
 37      arg Str disk ; arg Intn size 
 38      (var Stream s) open disk in+safe+nocache 
 39      if s=failure 
 40        return 0 
 41      if (os_ioctl s:stream_handle 1200h+96 addressof:(var uInt blocs))<>0 
 42        return 0 
 43      size := blocs*512n 
 44     
 45    type PartitionHeader 
 46      field uInt8 bootable 
 47      field uInt8 begin_cylinder begin_head begin_sector 
 48      field uInt8 type 
 49      field uInt8 end_cylinder end_head end_sector 
 50      field uInt32_li start 
 51      field uInt32_li size 
 52   
 53    function partition_create disk p -> status 
 54      arg Str disk ; arg_rw Array:DiskPartition p ; arg Status status 
 55      var Int sector_size := 512 
 56      var Int cylinder_sectors := 63*255 
 57      var Intn remain := get_disk_capacity:disk-cylinder_sectors*sector_size ; var Int undef := 0 
 58      for (var Int i) p:size-1 
 59        if p:i:size>0   
 60          var Intn cylinders := p:i:size\cylinder_sectors\sector_size 
 61          p:size := cylinders*cylinder_sectors*sector_size 
 62          remain -= p:size 
 63        else 
 64          undef += 1 
 65      if undef<>0 
 66        var Intn cylinders := remain\cylinder_sectors\sector_size\undef 
 67        for (var Int i) p:size-1 
 68          if p:i:size<=0 
 69            p:size := cylinders*cylinder_sectors*sector_size 
 70      var Address buffer := memory_zallocate sector_size null 
 71      (buffer translate Byte 510) map uInt16_hi := 55AAh 
 72      var uInt current := cylinder_sectors 
 73      for (var Int i) p:size-1 
 74        if not (p:i:device parse pattern:disk (var Int k)) or k<or k>4 
 75          memory_free buffer 
 76          return failure 
 77        var Pointer:PartitionHeader ph :> (buffer translate Byte 446+16*(k-1)) map PartitionHeader 
 78        ph bootable := 128 
 79        var Str fs := p:filesystem 
 80        ph type := shunt fs="ext2" or fs="ext3" or fs="xfs" 83h fs="swap" 82h fs="raid" 0FDh 7Fh 
 81        ph start := current 
 82        ph size := p:i:size\sector_size 
 83        current += ph size 
 84      (var Stream s) open disk in+out+safe+nocache 
 85      raw_write buffer sector_size 
 86      os_ioctl s:stream_handle 1200h+95 null 
 87      memory_free buffer 
 88      status := success 
 89   
 90  else 
 91   
 92    function partition_create disk p -> status 
 93      arg Str disk ; arg_rw Array:DiskPartition p ; arg Status status 
 94      (var Stream zero) open disk out+safe+nocache 
 95      var Address buf := memory_zallocate 512 null 
 96      zero raw_write buf 512 
 97      memory_free buf 
 98      zero close 
 99      var Str temp := file_temporary 
 100      (var Stream kbd) open temp out 
 101      kbd writechars "n[lf]p[lf]1[lf]1[lf]1[lf]w[lf]q[lf]" 
 102      kbd close 
 103      execute "fdisk "+file_os_name:disk input temp quiet 
 104      execute "fdisk -l "+file_os_name:disk output temp quiet 
 105      var Stream fdisk ; fdisk open temp in 
 106      var Int heads sectors cylinders bytes 
 107      var Bool ok := false 
 108      while not fdisk:atend 
 109        var Str l := fdisk readline 
 110        if (l parse "Disk" (pattern file_os_name:disk) ":" heads "heads" "," sectors "sectors" "," cylinders "cylinders") 
 111          l := fdisk readline 
 112          if (l parse "Units" "=" "cylinders" "of" any "*" bytes "bytes") 
 113            ok := true 
 114      if not ok 
 115        if trace 
 116          console "Failed to read "+file_os_name:disk+" disk geometry." eol 
 117        return failure 
 118      var Intn cylinder_capacity := 1n*heads*sectors*bytes 
 119      var Intn disk_capacity := cylinders*cylinder_capacity 
 120      if trace 
 121        console "  disk capacity is "+(string disk_capacity\2^20)+" MB[lf]" 
 122      var Int remain := cylinders 
 123      var Int undef := 0 
 124      for (var Int i) 0 p:size-1 
 125        if p:i:size>0   
 126          var Int cylcount := cast (p:i:size+cylinder_capacity\2)\cylinder_capacity Int 
 127          p:i size := cylcount*cylinder_capacity 
 128          remain -= cylcount 
 129        else 
 130          undef += 1 
 131      if undef<>0 
 132        for (var Int i) 0 p:size-1 
 133          if p:i:size<=0 
 134            var Int cylcount := remain\undef 
 135            p:i size := cylcount*cylinder_capacity 
 136            remain -= cylcount ; undef -= 1 
 137      var Int cylfirst := 1 
 138      for (var Int i) 0 p:size-1 
 139        var Int cylcount := cast p:i:size\cylinder_capacity Int 
 140        p:i first_cylinder := cylfirst 
 141        p:i last_cylinder := cylfirst+cylcount-1 
 142        cylfirst +=  cylcount 
 143        if trace 
 144          console "  " (left p:i:name 16 " "" " (left p:i:mountpoint 16 " "" " (left p:i:filesystem 8 " "" " (left (string p:i:first_cylinder)+"-"+(string p:i:last_cylinder) 16 " "" " p:i:size\2^20 "MB" eol 
 145      var Stream kbd ; kbd open temp out 
 146      kbd writechars "d[lf]1[lf]" 
 147      for (var Int i) 0 p:size-1 
 148        if not (p:i:device parse pattern:disk (var Int k)) or k<1 or k>4 
 149          kbd close ; file_delete temp ; return failure 
 150        kbd writechars "n[lf]p[lf]"+string:k+"[lf]"+(string p:i:first_cylinder)+"[lf]"+(string p:i:last_cylinder)+"[lf]" 
 151        var Str fs := p:i filesystem 
 152        if fs="ext2" 
 153          kbd writechars "a[lf]"+string:k+"[lf]" 
 154        var Int type := shunt fs="ext2" or fs="ext3" or fs="xfs" 83h fs="swap" 82h fs="raid" 0FDh 7Fh 
 155        kbd writechars "t[lf]"+string:k+"[lf]"+(string type "radix 16")+"[lf]" 
 156      kbd writechars "w[lf]q[lf]" 
 157      kbd close 
 158      status := shunt (execute "fdisk "+file_os_name:disk input temp quiet)=0 success failure 
 159      file_delete temp 
 160   
 161   
 162  function partition_tune partition tune 
 163    arg Str partition tune 
 164    # tune2fs will not accept to work if there is no /etc/mtab 
 165    var CBool buggy := (file_query "file:/etc/mtab" standard)=failure 
 166    if buggy 
 167      (var Stream s) open "file:/etc/mtab" out+safe+mkdir ; close  
 168    execute "tune2fs "+tune+" "+file_os_name:partition quiet 
 169    if buggy 
 170      file_delete "file:/etc/mtab"  
 171      file_delete "file:/etc/"  
 172   
 173   
 174  function partition_journal partition on 
 175    arg Str partition ; arg CBool on 
 176    partition_tune partition "-O "+(shunt on "" "^")+"has_journal" 
 177   
 178   
 179  function partition_format partition fs options -> status 
 180    arg Str partition fs options ; arg Status status 
 181    if fs="" or fs="ext2" or fs="ext3" 
 182      var Str opt := " -F" 
 183      if not (options option "nocheck") 
 184        opt += " -c" 
 185      if not (options option "standard") 
 186        opt += " -b 4096 -O sparse_super" 
 187      if (execute "mke2fs"+opt+" "+file_os_name:partition quiet)<>0 
 188        return failure 
 189      if (options option "name" Str)<>"" 
 190        partition_tune partition "-L "+(options option "name" Str) 
 191      if not (options option "notune") 
 192        partition_tune partition "-e remount-ro" 
 193      if fs="ext3" 
 194        partition_journal partition true 
 195      status := success 
 196    eif fs="xfs" 
 197      if (execute "mkfs.xfs -f"+(shunt (options option "name" Str)<>"" " -L "+(options option "name" Str) "")+" "+file_os_name:partition quiet)<>0 
 198        return failure 
 199      status := success 
 200    eif fs="swap" 
 201      (var Stream on) open "file:/proc/swaps" in+safe 
 202      while not on:atend 
 203        if (on:readline parse any:(var Str dev) _ any) and dev=file_os_name:partition 
 204          return failure     
 205      var Str opt := "" 
 206      if not (options option "nocheck") 
 207        opt += " -c" 
 208      if (execute "mkswap"+opt+" "+file_os_name:partition quiet)<>0 
 209        return failure 
 210      status := success 
 211    else 
 212      status := failure 
 213   
 214   
 215  export partition partition_create partition_format 
 216  export partition_journal 
 217   
 218   
 219  if recover 
 220   
 221    function partition_recover disk 
 222      arg Str disk 
 223      var Int sector_size := 512 
 224      var Address buffer := memory_zallocate sector_size null 
 225      (var Stream s) open disk in+safe+nocache 
 226      raw_read buffer sector_size 
 227      var Pointer:PartitionHeader ph :> (buffer translate Byte 446) map PartitionHeader 
 228      if ph:type=0 
 229        console "recovering partition" eol 
 230        ph type := 83h 
 231        (var Stream s) open disk in+out+safe+nocache 
 232        raw_write buffer sector_size 
 233      memory_free buffer 
 234       
 235    export partition_recover 
 236   
 237