Patch title: Release 92 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"



  function partition_create disk p -> status
    arg Str disk ; arg_rw Array:DiskPartition p ; arg Status
    var Int sector_size := 512
    var Int head_sectors := 64
    var Intn remain := get_disk_capacity:disk-head_sectors*s
    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 := head_sectors
    for (var Int i) 0 p:size-1
      if not (p:i:device parse pattern:disk (var Int k)) or 
        memory_free buffer
        return failure
      var Pointer:PartitionHeader ph :> (buffer translate By
      ph bootable := 128
      var Str fs := p:i filesystem
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"



  function partition_create disk p -> status
    arg Str disk ; arg_rw Array:DiskPartition p ; arg Status
    var Int sector_size := 512
    var Int head_sectors := 64
    var Intn remain := get_disk_capacity:disk-head_sectors*s
    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 := head_sectors
    for (var Int i) 0 p:size-1
      if not (p:i:device parse pattern:disk (var Int k)) or 
        memory_free buffer
        return failure
      var Pointer:PartitionHeader ph :> (buffer translate By
      ph bootable := 128
      var Str fs := p:i filesystem
      ph type := (shunt fs="ext2" 83h fs="swap" 82h fs="raid
      ph type := (shunt fs="ext2" or fs="xfs" 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


  function partition_create disk p -> status
    arg Str disk ; arg_rw Array:DiskPartition p ; arg 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) ":" hea
        l := fdisk readline
        if (l parse "Units" "=" "cylinders" "of" any "*" byt
          ok := true
    if not ok
      if trace
        console "Failed to read "+file_os_name:disk+" disk g
      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^
    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
        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 In
      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:mo
    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 
        kbd close ; file_delete temp ; return failure
      kbd writechars "n[lf]p[lf]"+string:k+"[lf]"+(string p:
      var Str fs := p:i filesystem
      if fs="ext2"
        kbd writechars "a[lf]"+string:k+"[lf]"
      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


  function partition_create disk p -> status
    arg Str disk ; arg_rw Array:DiskPartition p ; arg 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) ":" hea
        l := fdisk readline
        if (l parse "Units" "=" "cylinders" "of" any "*" byt
          ok := true
    if not ok
      if trace
        console "Failed to read "+file_os_name:disk+" disk g
      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^
    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
        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 In
      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:mo
    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 
        kbd close ; file_delete temp ; return failure
      kbd writechars "n[lf]p[lf]"+string:k+"[lf]"+(string p:
      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=
      var Int type := (shunt fs="ext2" or fs="xfs" 83h fs="swap" 82h fs="raid" 0FDh 0)
      kbd writechars "t[lf]"+string:k+"[lf]"+(string type "r
    kbd writechars "w[lf]q[lf]"
    kbd close
    status := shunt (execute "fdisk "+file_os_name:disk inpu
    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 quie
      return failure
    if (options option "name" Str)<>""
      kbd writechars "t[lf]"+string:k+"[lf]"+(string type "r
    kbd writechars "w[lf]q[lf]"
    kbd close
    status := shunt (execute "fdisk "+file_os_name:disk inpu
    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 quie
      return failure
    if (options option "name" Str)<>""
      execute "tune2fs -L [dq]"+(options option "name" Str)+
      execute "tune2fs -L "+(options option "name" Str)+" "+file_os_name:partition quiet
    if not (options option "notune")
      execute "tune2fs -e remount-ro "+file_os_name:partitio
    status := success
    if not (options option "notune")
      execute "tune2fs -e remount-ro "+file_os_name:partitio
    status := success
  eif fs="xfs"
    if (execute "mkfs.xfs -f"+(shunt (options option "name" Str)<>"" " -L "+(options option "name" Str) "")+" "+file_os_name:partition quiet)<>0
      return failure
    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
        return failure    
    var Str opt := ""
    if not (options option "nocheck")
      opt += " -c"
    if (execute "mkswap"+opt+" "+file_os_name:partition quie
      return failure
    status := success
  else
    status := failure



  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
        return failure    
    var Str opt := ""
    if not (options option "nocheck")
      opt += " -c"
    if (execute "mkswap"+opt+" "+file_os_name:partition quie
      return failure
    status := success
  else
    status := failure