Patch title: Release 91 bulk changes
Abstract:
File: /linux/storage/partition.pli
Key:
    Removed line
    Added line
module "/pliant/language/unsafe.pli"
module "/pliant/language/stream.pli"
module "/pliant/language/os.pli"
module "/pliant/admin/file.pli"
module "/pliant/admin/execute.pli"


constant fdisk false
constant trace false


doc
  [ioctls are defined in /usr/src/linux/drivers/block/hd.c]


public
  type DiskPartition
    field Str name
    field Str device
    field Str raid_devices
    field Str mountpoint
    field Intn size <- 0
    field Str filesystem
    field Str options
    if fdisk
      field Int first_cylinder last_cylinder

function partition n d mp size fs o -> p
  arg Str n d mp ; arg Intn size ; arg Str fs o ; arg DiskPartition p
  p name := n ; p device := d ; p mountpoint := mp ; p size := size ; p filesystem := fs ; p options := o


if not fdisk

  function get_disk_capacity disk -> size
    arg Str disk ; arg Intn size
    (var Stream s) open disk in+safe+nocache
    if s=failure
      return 0
    if (os_ioctl s:stream_handle 1200h+96 addressof:(var uInt blocs))<>0
      return 0
    size := blocs*512n
  
  type PartitionHeader
    field uInt8 bootable
    field uInt8 begin_cylinder begin_head begin_sector
    field uInt8 type
    field uInt8 end_cylinder end_head end_sector
    field uInt32_li start
    field uInt32_li size

  function partition_create disk p -> status
    arg Str disk ; arg_rw Array:DiskPartition p ; arg Status status
    var Int sector_size := 512
    var Intn remain := get_disk_capacity disk ; var Int undef := 0
    var Int head_sectors := 64
    var Intn remain := get_disk_capacity:disk-head_sectors*sector_size ; var Int undef := 0
    for (var Int i) 0 p:size-1
      if p:i:size>0  
        var Intn sectors := p:i:size\sector_size
        p:i size := sectors*sector_size
        remain -= p:i size
      else
        undef += 1
    if undef<>0
      var Intn sectors := remain\undef\sector_size
      for (var Int i) 0 p:size-1
        if p:i:size<=0
          p:i size := sectors*sector_size
    var Address buffer := memory_zallocate sector_size null
    (buffer translate Byte 510) map uInt16_hi := 55AAh
    var uInt current := 64
    var uInt current := head_sectors
    for (var Int i) 0 p:size-1
      if not (p:i:device parse pattern:disk (var Int k)) or k<1 or k>4
        memory_free buffer
        return failure
      var Pointer:PartitionHeader ph :> (buffer translate Byte 446+16*(k-1)) map PartitionHeader
      ph bootable := 128
      var Str fs := p:i filesystem
      ph type := (shunt fs="ext2" 83h fs="swap" 82h fs="raid" 0FDh 0)
      ph start := current
      ph size := p:i:size\sector_size
      current += ph size
    (var Stream s) open disk in+out+safe+nocache
    s raw_write buffer sector_size
    os_ioctl s:stream_handle 1200h+95 null
    memory_free buffer
    status := success

else

  function partition_create disk p -> status
    arg Str disk ; arg_rw Array:DiskPartition p ; arg Status status
    (var Stream zero) open disk out+safe+nocache
    var Address buf := memory_zallocate 512 null
    zero raw_write buf 512
    memory_free buf
    zero close
    var Str temp := file_temporary
    (var Stream kbd) open temp out
    kbd writechars "n[lf]p[lf]1[lf]1[lf]1[lf]w[lf]q[lf]"
    kbd close
    execute "fdisk "+file_os_name:disk input temp quiet
    execute "fdisk -l "+file_os_name:disk output temp quiet
    var Stream fdisk ; fdisk open temp in
    var Int heads sectors cylinders bytes
    var Bool ok := false
    while not fdisk:atend
      var Str l := fdisk readline
      if (l parse "Disk" (pattern file_os_name:disk) ":" heads "heads" "," sectors "sectors" "," cylinders "cylinders")
        l := fdisk readline
        if (l parse "Units" "=" "cylinders" "of" any "*" bytes "bytes")
          ok := true
    if not ok
      if trace
        console "Failed to read "+file_os_name:disk+" disk geometry." eol
      return failure
    var Intn cylinder_capacity := 1n*heads*sectors*bytes
    var Intn disk_capacity := cylinders*cylinder_capacity
    if trace
      console "  disk capacity is "+(string disk_capacity\2^20)+" MB[lf]"
    var Int remain := cylinders
    var Int undef := 0
    for (var Int i) 0 p:size-1
      if p:i:size>0  
        var Int cylcount := cast (p:i:size+cylinder_capacity\2)\cylinder_capacity Int
        p:i size := cylcount*cylinder_capacity
        remain -= cylcount
      else
        undef += 1
    if undef<>0
      for (var Int i) 0 p:size-1
        if p:i:size<=0
          var Int cylcount := remain\undef
          p:i size := cylcount*cylinder_capacity
          remain -= cylcount ; undef -= 1
    var Int cylfirst := 1
    for (var Int i) 0 p:size-1
      var Int cylcount := cast p:i:size\cylinder_capacity Int
      p:i first_cylinder := cylfirst
      p:i last_cylinder := cylfirst+cylcount-1
      cylfirst +=  cylcount
      if trace
        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
    var Stream kbd ; kbd open temp out
    kbd writechars "d[lf]1[lf]"
    for (var Int i) 0 p:size-1
      if not (p:i:device parse pattern:disk (var Int k)) or k<1 or k>4
        kbd close ; file_delete temp ; return failure
      kbd writechars "n[lf]p[lf]"+string:k+"[lf]"+(string p:i:first_cylinder)+"[lf]"+(string p:i:last_cylinder)+"[lf]"
      var Str fs := p:i filesystem
      if fs="ext2"
        kbd writechars "a[lf]"+string:k+"[lf]"
      var Int type := (shunt fs="ext2" 83h fs="swap" 82h fs="raid" 0FDh 0)
      kbd writechars "t[lf]"+string:k+"[lf]"+(string type "radix 16")+"[lf]"
    kbd writechars "w[lf]q[lf]"
    kbd close
    status := shunt (execute "fdisk "+file_os_name:disk input temp quiet)=0 success failure
    file_delete temp


function partition_format partition fs options -> status
  arg Str partition fs options ; arg Status status
  if fs="" or fs="ext2"
    var Str opt := " -F"
    if not (options option "nocheck")
      opt += " -c"
    if not (options option "standard")
      opt += " -b 4096 -O sparse_super"
    if (execute "mke2fs"+opt+" "+file_os_name:partition quiet)<>0
      return failure
    if (options option "name" Str)<>""
      execute "tune2fs -L [dq]"+(options option "name" Str)+"[dq] "+file_os_name:partition quiet
    if not (options option "notune")
      execute "tune2fs -e remount-ro "+file_os_name:partition quiet
    status := success
  eif fs="swap"
    (var Stream on) open "file:/proc/swaps" in+safe
    while not on:atend
      if (on:readline parse any:(var Str dev) _ any) and dev=file_os_name:partition
        return failure    
    var Str opt := ""
    if not (options option "nocheck")
      opt += " -c"
    if (execute "mkswap"+opt+" "+file_os_name:partition quiet)<>0
      return failure
    status := success
  else
    status := failure


export partition partition_create partition_format