Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

executable file 98 lines (78 sloc) 2.006 kb
#!/usr/bin/perl
#
# Creates a blank MS-DOS formatted hard disk image
#
use Fcntl;
($file,$c,$h,$s) = @ARGV;
$c += 0; $h += 0; $s += 0;
if ( !$file || $c < 1 || $c > 1024 ||
$h < 1 || $h > 256 || $s < 1 || $s > 63 ) {
print STDERR "Usage: $0 file c h s (max: 1024 256 63)\n";
exit 1;
}
$cylsize = $h*$s*512;
sysopen(OUTPUT, $file, O_CREAT|O_RDWR|O_TRUNC, 0666)
or die "$0: Cannot open: $file\n";
# Print the MBR and partition table
$mbr = '';
while ( $line = <DATA> ) {
chomp $line;
foreach $byte ( split(/\s+/, $line) ) {
$mbr .= chr(hex($byte));
}
}
if ( length($mbr) > 446 ) {
die "$0: Bad MBR code\n";
}
$mbr .= "\0" x (446 - length($mbr));
print OUTPUT $mbr;
# Print partition table
$psize = $c*$h*$s-$s;
$bhead = ($h > 1) ? 1 : 0;
$bsect = 1;
$bcyl = ($h > 1) ? 0 : 1;
$ehead = $h;
$esect = $s + (($c & 0x300) >> 2);
$ecyl = $c & 0xff;
if ( $psize > 65536 ) {
$fstype = 0x06;
} else {
$fstype = 0x04;
}
print OUTPUT pack("CCCCCCCCVV", 0x80, $bhead, $bsect, $bcyl, $fstype,
$ehead, $esect, $ecyl, $s, $psize);
print OUTPUT "\0" x 48;
print OUTPUT "\x55\xaa";
# Output blank file
$totalsize = $c*$h*$s;
$tracks = $c*$h;
$track = "\0" x (512*$s);
# Print fractional track
print OUTPUT "\0" x (512 * ($s-1));
for ( $i = 1 ; $i < $tracks ; $i++ ) {
print OUTPUT $track;
}
# Print mtools temp file
$tmpfile = "/tmp/mconfig.$$";
$offset = $s*512;
open(MCONFIG, "> ${tmpfile}") or die "$0: Cannot make mtools config\n";
print MCONFIG "drive z:\n";
print MCONFIG "file=\"\Q${file}\E\"\n";
print MCONFIG "cylinders=${c}\n";
print MCONFIG "heads=${h}\n";
print MCONFIG "sectors=${s}\n";
print MCONFIG "offset=${offset}\n";
close(MCONFIG);
$ENV{'MTOOLSRC'} = $tmpfile;
system('mformat', 'z:');
unlink($tmpfile);
seek(OUTPUT, $s*512+0x36, 0);
read(OUTPUT, $fsname, 8);
# FAT12: adjust partition type
if ( $fsname eq 'FAT12 ' ) {
$fstype = 0x01;
}
seek(OUTPUT, 446+4, 0);
print OUTPUT pack("C", $fstype);
exit 0;
__END__
Jump to Line
Something went wrong with that request. Please try again.