add udfhd.pl script

git-svn-id: svn://tug.org/texlive/trunk@33169 c570f23f-e606-0410-a88d-b1316a301751

1 files changed, 132 insertions, 0 deletions

diff --git a/Master/tlpkg/libexec/udfhd.pl b/Master/tlpkg/libexec/udfhd.pl
new file mode 100644
index 00000000000..5caeb00638b
--- /dev/null
+++ b/Master/tlpkg/libexec/udfhd.pl
@@ -0,0 +1,132 @@
+#!/usr/bin/perl -w
+
+#    udfhd.pl - partition and format a hard disk using UDF
+#    Copyright (C) 2010   Pieter Wuille
+#
+#    Changes in TeX Live:
+#    2014- Norbert Preining
+#     - error handling for missing arguments
+#
+#    This program is free software: you can redistribute it and/or modify
+#    it under the terms of the GNU General Public License as published by
+#    the Free Software Foundation, either version 3 of the License, or
+#    (at your option) any later version.
+#
+#    This program is distributed in the hope that it will be useful,
+#    but WITHOUT ANY WARRANTY; without even the implied warranty of
+#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#    GNU General Public License for more details.
+#
+#    You should have received a copy of the GNU General Public License
+#    along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+use strict;
+use Fcntl qw(SEEK_SET SEEK_END);
+
+my $SECTORSIZE=512;
+
+sub encode_lba {
+  my ($lba) = @_;
+  my $res=pack("V",$lba);
+  return $res;
+}
+
+sub encode_chs {
+  my ($lba,$heads,$sects) = @_;
+  my $C= $lba/($heads*$sects);
+  $C=1023 if ($C>1023);
+  my $S=1+($lba % $sects);
+  my $H=($lba/$sects) % $heads;
+  my $res=pack("WWW",$H & 255,($S&63)|((($C/256)&3)*64),$C&255);
+  return $res;
+}
+
+sub encode_entry {
+  my ($begin_sect,$size_sect,$bootable,$type,$heads,$sects) = @_;
+  return (pack("W",0) x 16) if ($size_sect == 0);
+  my $res="";
+  if ($bootable) { $res=pack("W",0x80); } else { $res=pack("W",0); }
+  $res .= encode_chs($begin_sect,$heads,$sects);
+  $res .= pack("W",$type);
+  $res .= encode_chs($begin_sect+$size_sect-1,$heads,$sects);
+  $res .= encode_lba($begin_sect);
+  $res .= encode_lba($size_sect);
+  return $res;
+}
+
+sub generate_fmbr {
+  use integer;
+  my ($maxlba,$heads,$sects)=@_;
+  $maxlba -= ($maxlba % ($heads*$sects));
+  my $res=pack("W",0) x 440; # code section
+  $res .= pack("V",0);       # disk signature
+  $res .= pack("W",0) x 2;   # padding
+  $res .= encode_entry(0,$maxlba,0,0x0B,$heads,$sects); # primary partition spanning whole disk
+  $res .= pack("W",0) x 48;  # 3 unused partition entries
+  $res .= pack("W",0x55);    # signature part 1
+  $res .= pack("W",0xAA);    # signature part 2
+  return ($res,$maxlba);
+}
+
+$|=1;
+
+if (($#ARGV < 0) || (! -e $ARGV[0])) {
+  print "Syntax: $0 /dev/diskdevice [label] [size_in_bytes]\n";
+  exit 1;
+}
+
+my $udfpath="";
+my $udftype;
+if (-x "/usr/bin/mkudffs") { $udfpath="/usr/bin/mkudffs"; $udftype="mkudffs" }
+if (-x "/sbin/newfs_udf") { $udfpath="/sbin/newfs_udf"; $udftype="newfs_udf" }
+
+if (! defined($udftype)) {
+  print STDERR "Neither mkudffs or newfs_udf could be found. Exiting.";
+}
+
+my $dev=shift @ARGV;
+my $label="UDF";
+if (defined $ARGV[0]) {
+  $label=shift @ARGV;
+}
+
+
+open DISK,"+<",$dev || die "Cannot open '$dev' read/write: $!";
+my $size=(-s $dev);
+if (defined $ARGV[0]) {
+  $size=shift @ARGV;
+}
+if ($size<=0) {
+  $size=sysseek DISK, 0, 2;
+  sysseek DISK, 0, 0;
+}
+if ($size<=0) {
+  seek(DISK,0,SEEK_END) || die "Cannot seek to end of device: $!";
+  my $size=tell(DISK);
+}
+seek(DISK,0,SEEK_SET) || die "Cannot seek to begin of device: $!";
+
+$size = (-s $dev) if ($size<=0);
+if ($size<=0) {
+  die "Cannot calculate device size, please use: $0 device label [size_in_bytes]";
+}
+
+print "Writing MBR...";
+my ($mbr,$maxlba) = generate_fmbr($size/$SECTORSIZE,255,63);
+print DISK $mbr || die "Cannot write MBR: $!";
+print "done\n";
+
+print "Cleaning first 4096 sectors...";
+for (my $i=1; $i<4096; $i++) {
+  print DISK (pack("W",0)x$SECTORSIZE) || die "Cannot clear sector $i: $!";
+}
+print "done\n";
+
+close DISK || die "Cannot close disk device: $!";
+
+print "Creating $maxlba-sector UDF v2.01 filesystem with label '$label' on $dev using $udftype...\n";
+if ($udftype eq "mkudffs") {
+  system($udfpath,"--blocksize=$SECTORSIZE","--udfrev=0x0201","--lvid=$label","--vid=$label","--media-type=hd","--utf8",$dev,$maxlba);
+} elsif ($udftype eq "newfs_udf") {
+  system($udfpath,"-b",$SECTORSIZE,"-m","blk","-t","ow","-s",$maxlba,"-r","2.01","-v",$label,"--enc","utf8",$dev);
+}