| |
| /pliant/linux/storage/cdrom.pli |
| |
| 1 |
module "/pliant/language/context.pli" | |
| 2 |
module "/pliant/language/stream.pli" | |
| 3 |
module "/pliant/language/stream/pipe.pli" | |
| 4 |
module "/pliant/fullpliant/this_computer.pli" | |
| 5 |
module "/pliant/linux/kernel/module.pli" | |
| 6 |
module "/pliant/linux/kernel/device.pli" | |
| 7 |
module "/pliant/admin/execute.pli" | |
| 8 |
module "/pliant/admin/file.pli" | |
| 9 |
module "/pliant/language/ui/ansi_terminal.pli" | |
| 10 |
| |
| 11 |
constant debug false | |
| 12 |
| |
| 13 |
| |
| 14 |
function path_concat p1 p2 -> p | |
| 15 |
arg Str p1 p2 p | |
| 16 |
if p1:len>0 and p1:(p1:len-1)="/" and p2:len>0 and p2:0="/" | |
| 17 |
p := p1+(p2 1 p2:len) | |
| 18 |
else | |
| 19 |
p := p1+p2 | |
| 20 |
| |
| 21 |
function cdrom_tree files path -> status | |
| 22 |
arg List:FileInfo files ; arg Str path ; arg ExtendedStatus status | |
| 23 |
var Pointer:FileInfo file :> files first | |
| 24 |
while exists:file | |
| 25 |
var Str name := file:options option "cdname" Str | |
| 26 |
if name="" | |
| 27 |
name := file_os_name file:name | |
| 28 |
file_tree_create (path_concat path name) | |
| 29 |
file_link file:name (path_concat path name) | |
| 30 |
file :> files next file | |
| 31 |
| |
| 32 |
function graft_encode c -> e | |
| 33 |
arg Str c e | |
| 34 |
e := replace (replace c "\" "\\") "=" "\=" | |
| 35 |
| |
| 36 |
function mkisofs_name file -> name | |
| 37 |
arg FileInfo file ; arg Str name | |
| 38 |
name := file:options option "cdname" Str | |
| 39 |
if name="" | |
| 40 |
name := file_os_name file:name | |
| 41 |
if (name 0 1)="/" and name:len>1 | |
| 42 |
name := name 1 name:len | |
| 43 |
name := "/"+graft_encode:name+"="+graft_encode:(file_os_name file:name) | |
| 44 |
| |
| 45 |
function cdrom_image files options image -> status | |
| 46 |
arg List:FileInfo files ; arg Str options ; arg Str image ; arg ExtendedStatus status | |
| 47 |
var CBool query_size := options option "query_size" | |
| 48 |
var Str path := options option "path" Str | |
| 49 |
var Str boot := options option "boot" Str | |
| 50 |
if path="" and not (exists files:first) | |
| 51 |
return failure:"Nothing to engrave" | |
| 52 |
if path="" and boot<>"" | |
| 53 |
return failure:"Cannot engrave a bootable CD from a files list" | |
| 54 |
var CBool backup := options option "backup" | |
| 55 |
var Str mk:= "mkisofs -quiet -D" | |
| 56 |
if (options option "linktransparent") | |
| 57 |
mk += " -f" | |
| 58 |
if boot<>"" | |
| 59 |
mk += " -R -b "+boot | |
| 60 |
eif backup | |
| 61 |
mk += " -R" | |
| 62 |
else | |
| 63 |
mk += " -r" | |
| 64 |
var Str title := options option "title" Str | |
| 65 |
if title<>"" | |
| 66 |
mk += " -V "+title | |
| 67 |
if (options option "macintosh") and (options option "osx") | |
| 68 |
mk += " -hfs --netatalk --osx-double" | |
| 69 |
eif (options option "macintosh") | |
| 70 |
mk += " -hfs --netatalk" | |
| 71 |
eif (options option "osx") | |
| 72 |
mk += " -hfs --osx-double" | |
| 73 |
if (options option "windows") | |
| 74 |
mk += " -J" | |
| 75 |
var Str file_in file_out | |
| 76 |
if query_size | |
| 77 |
mk += " -print-size" | |
| 78 |
eif file_os_name:image<>"" | |
| 79 |
mk += " -o "+file_os_name:image | |
| 80 |
var Str extra := options option "mkisofs_extra_options" Str | |
| 81 |
if extra<>"" | |
| 82 |
mk += " "+extra | |
| 83 |
if path<>"" | |
| 84 |
mk += " "+file_os_name:path | |
| 85 |
else | |
| 86 |
var Str flist := file_temporary | |
| 87 |
mk += " -graft-points -path-list "+file_os_name:flist+" '"+(mkisofs_name files:first)+"'" | |
| 88 |
(var Stream s) open flist out+safe | |
| 89 |
var Pointer:FileInfo file :> files next files:first | |
| 90 |
while exists:file | |
| 91 |
s writeline mkisofs_name:file | |
| 92 |
file :> files next file | |
| 93 |
if s:close=failure | |
| 94 |
file_delete flist | |
| 95 |
return failure:"Failed to generate files list temporary file" | |
| 96 |
if debug | |
| 97 |
console mk eol | |
| 98 |
if query_size | |
| 99 |
var Str ofile := file_temporary | |
| 100 |
var Str efile := file_temporary | |
| 101 |
var Int err := execute mk output ofile error efile | |
| 102 |
s open ofile in+safe | |
| 103 |
var Str oanswer := s readline | |
| 104 |
s close | |
| 105 |
file_delete ofile | |
| 106 |
s open efile in+safe | |
| 107 |
var Str eanswer := s readline | |
| 108 |
s close | |
| 109 |
file_delete efile | |
| 110 |
status := shunt err=0 success (failure "mkisofs returned error code "+string:err) | |
| 111 |
if (oanswer parse (var Intn sectors)) or (eanswer parse any "=" (var Intn sectors)) | |
| 112 |
status message := string sectors*2048n | |
| 113 |
else | |
| 114 |
var Int err | |
| 115 |
part mk "Building CD "+title+" ISO9660 image" | |
| 116 |
if file_os_name:image<>"" | |
| 117 |
err := execute mk output "file:/tmp/cdrom.log" mixed | |
| 118 |
else | |
| 119 |
err := execute mk output image error "file:/tmp/cdrom.log" mixed | |
| 120 |
status := shunt err=0 success failure:"Failed to build ISO9660 image" | |
| 121 |
if file_os_name:image<>"" and status=success and (file_query image standard)=failure | |
| 122 |
status := failure "mkisofs internal bug" | |
| 123 |
if debug and path<>"" | |
| 124 |
file_tree_delete "file:/tmp/bug/" | |
| 125 |
var Array:FileInfo pfiles := file_list path standard+recursive+relative | |
| 126 |
for (var Int i) 0 pfiles:size-1 | |
| 127 |
if (pfiles:i:name search ".AppleDouble/" -1)<>(-1) | |
| 128 |
var Intn remain := pfiles:i:size | |
| 129 |
(var Stream src) open path+pfiles:i:name in+safe | |
| 130 |
(var Stream dest) open "file:/tmp/bug/"+pfiles:i:name out+safe+mkdir | |
| 131 |
var Address buf := memory_zallocate 4096 null | |
| 132 |
while remain>0 | |
| 133 |
var Int step := shunt remain>4096 4096 (cast remain Int) | |
| 134 |
src raw_read buf step | |
| 135 |
dest raw_write buf step | |
| 136 |
remain -= step | |
| 137 |
memory_free buf | |
| 138 |
src close | |
| 139 |
dest close | |
| 140 |
else | |
| 141 |
var Intn remain := pfiles:i:size | |
| 142 |
(var Stream dest) open "file:/tmp/bug/"+pfiles:i:name out+safe+mkdir | |
| 143 |
var Address buf := memory_zallocate 4096 null | |
| 144 |
while remain>0 | |
| 145 |
var Int step := shunt remain>4096 4096 (cast remain Int) | |
| 146 |
dest raw_write buf step | |
| 147 |
remain -= step | |
| 148 |
memory_free buf | |
| 149 |
dest close | |
| 150 |
if status=success | |
| 151 |
file_delete "file:/tmp/cdrom.log" | |
| 152 |
eif path="" | |
| 153 |
file_delete "file:/tmp/cdrom.list" | |
| 154 |
file_move flist "file:/tmp/cdrom.list" | |
| 155 |
if path="" | |
| 156 |
file_delete flist | |
| 157 |
if debug | |
| 158 |
(var Stream s) open "file:/tmp/mkisofs.log" out+safe | |
| 159 |
s writeline mk | |
| 160 |
if path<>"" | |
| 161 |
s writeline "path is "+string:path | |
| 162 |
var Array:FileInfo pfiles := file_list path standard+recursive | |
| 163 |
var Intn total := 0 | |
| 164 |
for (var Int i) 0 pfiles:size-1 | |
| 165 |
# s writeline " "+pfiles:i:name+" "+(string pfiles:i:size) | |
| 166 |
total += pfiles:i:size | |
| 167 |
s writeline (string pfiles:size)+" files "+string:total+" bytes" | |
| 168 |
else | |
| 169 |
var Int count := 0 ; var Intn total := 0 | |
| 170 |
var Pointer:FileInfo file :> files next files:first | |
| 171 |
while exists:file | |
| 172 |
# s writeline " "+file:name+" "+(string file:size) | |
| 173 |
count += 1 ; total += file size | |
| 174 |
file :> files next file | |
| 175 |
s writeline string:count+" files "+string:total+" bytes" | |
| 176 |
if file_os_name:image<>"" | |
| 177 |
s writeline "ISO9660 file size is "+(string (file_query image standard):size)+" bytes" | |
| 178 |
if status=failure | |
| 179 |
s writeline "error message is "+status:message | |
| 180 |
| |
| 181 |
| |
| 182 |
function cdrom_record image options -> status | |
| 183 |
arg Str image options ; arg ExtendedStatus status | |
| 184 |
var Str engraver := "engraver"+(options option "engraver" Str) | |
| 185 |
var Str interface := this_computer:env:"hardware":engraver:"interface" | |
| 186 |
var Str medium := this_computer:env:"hardware":engraver:"medium" | |
| 187 |
if medium="" | |
| 188 |
medium := "cd" | |
| 189 |
var Str device := this_computer:env:"hardware":engraver:"device" | |
| 190 |
if device="" | |
| 191 |
device := shunt interface="ide" "device:/hdc" interface="usb" or interface="scsi" "device:/scd0" "" | |
| 192 |
var Str engraver_options := this_computer:env:"hardware":engraver:"options" | |
| 193 |
if not (this_computer:env:"hardware":engraver:"speed" parse (var Int speed)) | |
| 194 |
speed := undefined | |
| 195 |
if not (this_computer:env:"hardware":engraver:"cache_mb" parse (var Int cache_mb)) | |
| 196 |
cache_mb := memory_assigned\16\2^20 | |
| 197 |
cache_mb := max (min cache_mb 16) 4 | |
| 198 |
if interface="ide" | |
| 199 |
kernel_unload_module "ide-cd" | |
| 200 |
kernel_unload_module "cdrom" | |
| 201 |
kernel_load_module "scsi_mod" | |
| 202 |
kernel_load_module "ide-scsi" | |
| 203 |
kernel_load_module "sg" | |
| 204 |
sleep 5 | |
| 205 |
eif interface="usb" | |
| 206 |
kernel_load_module "usbcore" | |
| 207 |
kernel_load_module "ehci_hcd" | |
| 208 |
kernel_load_module "scsi_mod" | |
| 209 |
kernel_load_module "cdrom" | |
| 210 |
kernel_load_module "sr_mod" | |
| 211 |
kernel_load_module "usb_storage" | |
| 212 |
kernel_load_module "sg" | |
| 213 |
sleep 5 | |
| 214 |
eif interface="scsi" | |
| 215 |
kernel_unload_module "sr_mod" | |
| 216 |
kernel_unload_module "cdrom" | |
| 217 |
kernel_load_module "sg" | |
| 218 |
sleep 5 | |
| 219 |
if (engraver_options option "pio") | |
| 220 |
execute "hdparm -d0 "+file_os_name:device quiet | |
| 221 |
eif (engraver_options option "dma") | |
| 222 |
execute "hdparm -d1 "+file_os_name:device quiet | |
| 223 |
if this_computer:env:"pliant":"system":"distribution"="fullpliant" | |
| 224 |
for (var Int i) 0 15 | |
| 225 |
kernel_make_device "device:/sg"+string:i | |
| 226 |
for (var Int i) 0 3 | |
| 227 |
kernel_make_device "device:/pg"+string:i | |
| 228 |
var Str dev := this_computer:env:"hardware":engraver:"scsi_id" | |
| 229 |
if dev="" | |
| 230 |
dev := shunt interface="ide" "0,0,0" file_os_name:(replace device "device:/scd" "device:/sg")+":@" | |
| 231 |
eif (dev parse (var Int scsi_id)) | |
| 232 |
dev := "0,"+dev+",0" | |
| 233 |
eif (dev parse (var Int scsi_channel) "," (var Int scsi_id)) | |
| 234 |
dev := dev+",0" | |
| 235 |
var Str rec := shunt (options option "dvdrecord") "dvdrecord" "cdrecord" | |
| 236 |
rec += shunt (options option "dummy") " -dummy" "" | |
| 237 |
rec += shunt (engraver_options option "dao") " -dao" "" | |
| 238 |
rec += shunt (engraver_options option "sao") " -sao" "" | |
| 239 |
rec += shunt (engraver_options option "packet") " -packet" "" | |
| 240 |
rec += shunt (engraver_options option "eject") " -eject" "" | |
| 241 |
rec += shunt (engraver_options option "burnfree") " -driveropts=burnfree" "" | |
| 242 |
rec += shunt (engraver_options option "overburn") " -overburn" "" | |
| 243 |
rec += " dev="+dev | |
| 244 |
rec += shunt speed=defined " speed="+string:speed "" | |
| 245 |
rec += shunt cache_mb=defined " fs="+string:cache_mb+"m" "" | |
| 246 |
if file_os_name:image="" and (options option "size") | |
| 247 |
rec += " tsize="+(string (options option "size" Intn)\2048) | |
| 248 |
rec += " " | |
| 249 |
var Str stdin := "-" | |
| 250 |
if medium<>"cd" and (options option "growisofs") | |
| 251 |
rec := "growisofs -dvd-compat"+(shunt (options option "rw") " -use-the-force-luke" "")+" -Z "+file_os_name:device+"=" | |
| 252 |
stdin := "/proc/self/fd/0" | |
| 253 |
var Int err | |
| 254 |
part engrave | |
| 255 |
if (options option "rw") and not (options option "dummy") and (engraver_options option "blank" Str)<>"no" | |
| 256 |
var Str blank := shunt (options option "dvdrecord") "dvdrecord" "cdrecord" | |
| 257 |
blank += " dev="+dev | |
| 258 |
blank += shunt speed=defined " speed="+string:speed "" | |
| 259 |
blank += " blank="+(engraver_options option "blank" Str "fast") | |
| 260 |
if debug | |
| 261 |
console blank eol | |
| 262 |
part blank "Blanking read/write CD" | |
| 263 |
var Int seconds := engraver_options option "keyboard" Int | |
| 264 |
if seconds=defined | |
| 265 |
stream_pipe (var Str pipe_in) (var Str pipe_out) | |
| 266 |
thread | |
| 267 |
(var Stream kbd) open pipe_out out+safe | |
| 268 |
sleep seconds | |
| 269 |
kbd writeline "" | |
| 270 |
kbd flush anytime | |
| 271 |
err := execute blank input pipe_in output "file:/tmp/cdrom.log" mixed | |
| 272 |
else | |
| 273 |
err := execute blank output "file:/tmp/cdrom.log" mixed | |
| 274 |
if err=0 | |
| 275 |
file_delete "file:/tmp/cdrom.log" | |
| 276 |
else | |
| 277 |
status := failure "Failed to blank RW CD" | |
| 278 |
if file_os_name:image="" | |
| 279 |
(var Stream pipe) open image in+safe ; pipe close | |
| 280 |
leave engrave | |
| 281 |
part record "Engraving ISO9660 image on CD "+(options option "title" Str) | |
| 282 |
if file_os_name:image<>"" | |
| 283 |
if debug | |
| 284 |
console rec+file_os_name:image eol | |
| 285 |
err := execute rec+file_os_name:image output "file:/tmp/cdrom.log" mixed | |
| 286 |
else | |
| 287 |
if debug | |
| 288 |
console rec+stdin eol | |
| 289 |
err := execute rec+stdin input image output "file:/tmp/cdrom.log" mixed | |
| 290 |
if err=0 | |
| 291 |
file_delete "file:/tmp/cdrom.log" | |
| 292 |
status := success | |
| 293 |
else | |
| 294 |
(var Stream log) open "file:/tmp/cdrom.log" append+safe | |
| 295 |
log writeline "" | |
| 296 |
log writeline rec | |
| 297 |
log close | |
| 298 |
status := failure "Failed to engrave the CD ISO9660 image" | |
| 299 |
if file_os_name:image<>"" | |
| 300 |
status message += " ("+(string (file_query image standard):size)+" bytes)" | |
| 301 |
if interface="ide" | |
| 302 |
kernel_unload_module "sg" | |
| 303 |
kernel_unload_module "ide-scsi" | |
| 304 |
kernel_unload_module "scsi_mod" | |
| 305 |
kernel_load_module "cdrom" | |
| 306 |
kernel_load_module "ide-cd" | |
| 307 |
sleep 5 | |
| 308 |
eif interface="scsi" | |
| 309 |
kernel_unload_module "sg" | |
| 310 |
kernel_load_module "cdrom" | |
| 311 |
kernel_load_module "sr_mod" | |
| 312 |
sleep 5 | |
| 313 |
| |
| 314 |
| |
| 315 |
function cdrom_engrave files options -> status | |
| 316 |
arg List:FileInfo files ; arg Str options ; arg ExtendedStatus status | |
| 317 |
var Str engraver := "engraver"+(options option "engraver" Str) | |
| 318 |
var Str engraver_options := this_computer:env:"hardware":engraver:"options" | |
| 319 |
var CBool indirect := (engraver_options option "indirect") or (options option "indirect") | |
| 320 |
if (options option "macintosh") and (options option "capacity_mb") # workarount mkisofs buggy -print-size option | |
| 321 |
indirect := true | |
| 322 |
var Str path := options option "path" Str | |
| 323 |
if (options option "buggy") and path="" # workaround mkisofs buggy -graft-points option | |
| 324 |
var Str temp := file_temporary+"/" | |
| 325 |
cdrom_tree files temp | |
| 326 |
status := cdrom_engrave (var List:FileInfo empty_list) options+" path "+string:temp+" linktransparent" | |
| 327 |
file_tree_delete temp | |
| 328 |
return | |
| 329 |
var Int capacity_mb := options option "capacity_mb" Int | |
| 330 |
if capacity_mb=defined | |
| 331 |
if ((cdrom_image files options+" query_size" ""):message parse (var Intn size)) | |
| 332 |
if size>=capacity_mb*2n^20 | |
| 333 |
status := failure string:size+" bytes is too much for a CD image" | |
| 334 |
if indirect | |
| 335 |
var Str image := file_temporary | |
| 336 |
status := cdrom_image files options image | |
| 337 |
if status=success | |
| 338 |
status := cdrom_record image options | |
| 339 |
if status=success | |
| 340 |
var Intn imagesize := (file_query image standard):size | |
| 341 |
status message := string:imagesize+" bytes in the CD image" | |
| 342 |
file_delete image | |
| 343 |
else | |
| 344 |
var Str extra := "" | |
| 345 |
if (engraver_options option "size") and ((cdrom_image files options+" query_size" ""):message parse (var Intn size)) | |
| 346 |
extra += " size "+string:size | |
| 347 |
stream_pipe (var Str pipe_in) (var Str pipe_out) | |
| 348 |
var ExtendedStatus status1 status2 | |
| 349 |
part pipe "CD engraving pipe" | |
| 350 |
parallel threads 2 | |
| 351 |
task | |
| 352 |
share status1 := cdrom_image files options pipe_out | |
| 353 |
task | |
| 354 |
share status2 := cdrom_record pipe_in options+extra | |
| 355 |
status := shunt status1=failure status1 status2 | |
| 356 |
if debug and status=success | |
| 357 |
file_delete "file:/tmp/mkisofs.log" | |
| 358 |
| |
| 359 |
| |
| 360 |
function cdrom_file path cdname -> info | |
| 361 |
arg Str path cdname ; arg FileInfo info | |
| 362 |
info name := path | |
| 363 |
info options := "cdname "+string:cdname | |
| 364 |
| |
| 365 |
function cdrom_file path -> info | |
| 366 |
arg Str path ; arg FileInfo info | |
| 367 |
info name := path | |
| 368 |
info options := "" | |
| 369 |
| |
| 370 |
function cdrom_engrave path options -> status | |
| 371 |
arg Str path options ; arg ExtendedStatus status | |
| 372 |
status := cdrom_engrave (var List:FileInfo empty_list) "path "+string:path+" "+options | |
| 373 |
| |
| 374 |
| |
| 375 |
export cdrom_engrave | |
| 376 |
export cdrom_image cdrom_record | |
| 377 |
export cdrom_file | |
| |