#!/usr/bin/perl -w
 
#---------------------------------------------------------------------------
#@COPYRIGHT :
#             Copyright 1998, Alex P. Zijdenbos
#             McConnell Brain Imaging Centre,
#             Montreal Neurological Institute, McGill University.
#             Permission to use, copy, modify, and distribute this
#             software and its documentation for any purpose and without
#             fee is hereby granted, provided that the above copyright
#             notice appear in all copies.  The author and McGill University
#             make no representations about the suitability of this
#             software for any purpose.  It is provided "as is" without
#             express or implied warranty.
#---------------------------------------------------------------------------- 
#$RCSfile: cdroast.pl,v $
#$Revision: 1.11 $
#$Author: alex $
#$Date: 1999/11/17 21:34:10 $
#$State: Exp $
#---------------------------------------------------------------------------

use MNI::Startup;
use MNI::Spawn;
use MNI::FileUtilities qw(check_input_dirs check_output_dirs test_file);
use Getopt::Tabular;
use IO::File;
use Sys::Hostname;
use Env 'HOME';

use strict;

# User-modifiable globals
my($CDROM)    = '/dev/scd0';
my($Dev)      = '1,0';
my($MountDev) = '/dev/scd1';
my($ImageDir) = '/scratch';
my($CreateImage) = 0;
my($KeepImage) = 0;
my($Multi)    = 1;
my($Roast)    = 1;
my($Image)    = undef;
my($Speed)    = 2;
my($FIFO)     = '8m';
my($Joliet)   = 1;
my($Erase)    = 0;
my($Eject)    = 0;
my($Dummy)    = 0;
my($Copy)     = 0;
my(@Path)     = ();
my($All)      = 0;

# Other globals
my($Usage, $Help);
my($Conf)     = 'cdroast.conf';
my(@ConfDirs) = ('.',
		 $HOME,
		 "${HOME}/etc",
		 '/etc');
my($Blocks);
my($Append) = 1;
my(@MKISOFS);
my(@CDRECORD);

&Initialize;

# Check whether the disk is currently mounted
my $Status;
my $MountDisk = 0;
Spawn('mount', stdout => \$Status);
if ($Status =~ /$MountDev/) {
    # Try to unmount the disk
    $Status = Spawn(['umount', $MountDev], err_action => 'ignore');
    $MountDisk = ! $Status;
    if ($Status && ($Status != 512)) {
	die "Couldn't umount $MountDev; make sure the disk is not being accessed\n";
    }
}

ReloadSCSI();

# Collect block indices for multi-session write
if ($Append && !$Erase && !$Copy) {
    Spawn([@CDRECORD, '-msinfo'], stdout => \$Blocks);

    ($Blocks) = ($Execute)? $Blocks =~ /(\d+,\d+)\n$/ : "0, 10";
    
    $Append = 0 if (! defined($Blocks));
}

# First erase the CD, if requested
if ($Erase) {
    Spawn([@CDRECORD, 'blank=fast']);
    $Append = 0;
}

# Set write-time cdrecord options
push(@CDRECORD, '-eject') if ($Eject);
push(@CDRECORD, '-dummy') if ($Dummy);

# Copy CD from CD-ROM
if ($Copy && $Roast) {
    Spawn([@CDRECORD, "fs=$FIFO", '-isosize', $CDROM]);
}

# ... or burn the given image
elsif ($Roast && ! @Path && defined $Image && -e $Image) {
    Spawn([@CDRECORD, $Image]);
}

# ... or write supplied path(s)
elsif (@Path) {
    if ($Append) {
	push(@MKISOFS, '-C', $Blocks, '-M', $MountDev);
    }

    if ($CreateImage) {
	Spawn([@MKISOFS, '-o', $Image, @Path]);
	Spawn([@CDRECORD, $Image]) if $Roast;
	unlink $Image unless $KeepImage;
    }
    else {
	my($tracksize);
	Spawn([@MKISOFS, '-q', '-print-size', @Path], stderr => \$tracksize);
	chop($tracksize);
	$tracksize =~ s/^.* (\d+)$/$1/;
	Spawn(Stringify([@MKISOFS, @Path]) . ' | ' . 
	      Stringify([@CDRECORD, "fs=$FIFO", "tsize=${tracksize}s"]) . ' -') 
	    if $Roast;
    }
}

# Nothing was written to the disk; don't try to remount it
elsif ($Erase) {
    $MountDisk = 0;
}

ReloadSCSI();

# Remount disk if it was mounted at the onset
Spawn(['mount', $MountDev]) if $MountDisk;

# ------------------------------ MNI Header ----------------------------------
#@NAME       : Initialize
#@INPUT      : 
#@OUTPUT     : 
#@RETURNS    : 
#@DESCRIPTION: 
#@METHOD     : 
#@GLOBALS    : 
#@CALLS      : 
#@CREATED    : 98/11/29, Alex Zijdenbos
#@MODIFIED   : 
#-----------------------------------------------------------------------------
sub Initialize
{
   $, = ' ';     # set output field separator

   # First, announce ourselves to stdout (for ease in later dissection
   # of log files) -- unless STDOUT is a tty.
   self_announce if $Verbose && ! -t "STDOUT";

   # Set defaults for the global variables.
   $Verbose      = 1;
   $Execute      = 1;
   $Clobber      = 0;
   $KeepTmp      = 0;

   # mkisofs options
   my($mkisofs_b) = undef;
   my($mkisofs_c) = undef;
   my($mkisofs_T) = undef;
   my($mkisofs_V) = undef;
   my($mkisofs_other) = undef;
   my($first_session) = 0;

   &CreateInfoText;

   my($dev, $mountdev, $cdrom, $imagedir, $speed);

   # Parse configuration file
   &ParseConf(\@ConfDirs, $Conf, \$Dev, \$MountDev, \$CDROM, \$ImageDir, \$Speed);

   my(@argTbl) =
       (@DefaultArgs,
	["Device and path settings", "section"],
	["-image_dir", "string", 1, \$imagedir,
	 "directory to temporarily store CD image in [default: $ImageDir]", "<dir>"],
	["-device", "string", 1, \$dev,
	 "SCSI device specification of the CD writer (see cdrecord) [default: $Dev]", 
	 "<devicename:scsibus,target,lun>|<devicename:target,lun>"],
	["-mountdevice", "string", 1, \$mountdev,
	 "mount device of CD writer [default: $MountDev]", "<device>"],
	["-cdrom", "string", 1, \$cdrom,
	 "mount device of CD-ROM drive [default: $CDROM]", "<device>"],
	["-fifo", "string", 1, \$FIFO,
	 "size of fifo buffer (ignored with -create_image) [default: $FIFO]", "<size>"],
	["-first_session", "boolean", 1, \$first_session,
	 "assume this is the first session on the disk; don't try to get the session offset from the disk"],
	["-multi|-nomulti", "boolean", 1, \$Multi,
	 "write in multi-session mode [default; opposite is -nomulti]"],

	["Options passed to mkisofs", "section"],
	["-mb", "string", 1, \$mkisofs_b, 
	 "path and filename of boot image (mkisofs -b)", "<boot_image>"],
	["-mc", "string", 1, \$mkisofs_c, 
	 "path and filename of boot catalog (mkisofs -c)", "<boot_catalog>"],
	["-T", "copy", undef, \$mkisofs_T, 
	 "generate TRANS.TBL files in each directory"],
	["-V", "string", 1, \$mkisofs_V, 
	 "Volume ID", "<volid>"],
	["-mkisofs", "string", 1, \$mkisofs_other, 
	 "any other options to pass straight to mkisofs (quoted)", "<options>"],

	["CD image options", "section"],
	["-create_image|-nocreate_image", "boolean", 1, \$CreateImage,
	 "explicitly create disk image in -image_dir (safer but slower) [default: -nocreate_image]"],
	["-keep_image|-nokeep_image", "boolean", 1, \$KeepImage,
	 "keep created image [default: -nokeep_image]"],
	["-image", "string", 1, \$Image, 
	 "CD image file to create or burn. If <image.iso> exists, it will be passed to cdrecord for burning; if it doesn't exist, it will be created (which implies -create_image and -keep_image)", "<image.iso>"],
	["-all|-skipbackup", "boolean", 1, \$All,
	 "write all files [default: skip files containing '~' and '#']"],
	["-joliet|-nojoliet", "boolean", 1, \$Joliet,
	 "generate Joliet extensions [default; opposite is -nojoliet]"],

	["Writing options", "section"],
	["-roast|-noroast", "boolean", 1, \$Roast,
	 "actually roast the CD [default; opposite is -noroast]"],
	["-dummy|-for_real", "boolean", 1, \$Dummy,
	 "only simulate the roast [default: -for_real]"],
	["-erase|-noerase", "boolean", 1, \$Erase,
	 "erase disk prior to writing (CD-RW only) [default: -noerase]"],
	["-copy|-nocopy", "boolean", 1, \$Copy,
	 "copy disk from CD-ROM (see notes below) [default: -nocopy]"],
	["-speed", "integer", 1, \$speed,
	 "writing speed [default: $Speed]", "<speed>"],
	["-eject|-noeject", "boolean", 1, \$Eject,
	 "eject disk after writing [default: -noeject]"],
	);
   
   my(@leftOverArgs);

   GetOptions (\@argTbl, \@ARGV, \@leftOverArgs) || die "\n";
   if (@leftOverArgs < 1 && !$Erase && !$Copy && !defined $Image && ! -e $Image) {
       warn $Usage;
       die "Incorrect number of arguments\n";
   }

   # Overwrite using command-line values, if specified
   $Dev      = $dev if (defined $dev && $dev);
   $MountDev = $mountdev if (defined $mountdev && $mountdev);
   $CDROM    = $cdrom if (defined $cdrom && $cdrom);
   $ImageDir = $imagedir if (defined $imagedir && $imagedir);
   $Speed    = $speed if (defined $speed && $speed);

   if (defined $Image) {
       if (! -e $Image) {
	   $CreateImage = 1;
	   $KeepImage = 1;
       }
   }
   elsif ($CreateImage) {
       $Image = UniqueImageFile($ImageDir);
   }

   @Path = @leftOverArgs;

   if (@Path) {
       die "You cannot specify <dir> with -copy\n" if ($Copy);
       die "CD image $Image exists; you cannot specify a <path> in this case\n" 
	   if (defined $Image && -e $Image);
       check_input_dirs(@Path) || die "Arguments should be directories\n";
   }

   RegisterPrograms([qw(mkisofs cdrecord mount umount sudo)]) || die;
   RegisterPrograms([qw(lsmod)], '/sbin') || die;

   # Be strict about having programs registered
   MNI::Spawn::SetOptions (strict => 2);

   &check_output_dirs($ImageDir) if ($Execute && $CreateImage);

   @CDRECORD = ('cdrecord', "dev=${Dev}", "speed=${Speed}");
   push(@CDRECORD, '-multi') if (!$Copy && $Multi);
   push(@CDRECORD, '-v') if ($Verbose);

   @MKISOFS = ('mkisofs', '-r');
   push(@MKISOFS, '-J') if ($Joliet);
   push(@MKISOFS, '-a') if ($All);

   if (defined($mkisofs_b)) {
       die "couldn't find boot image $mkisofs_b: $!\n" if (! -e $mkisofs_b);
       push(@MKISOFS, '-b', $mkisofs_b);
   }
   if (defined($mkisofs_c)) {
       die "boot catalog $mkisofs_c exists!\n" if (-e $mkisofs_c);
       push(@MKISOFS, '-c', $mkisofs_c);
   }
   if (defined($mkisofs_T)) {
       push(@MKISOFS, $mkisofs_T);
   }
   if (defined($mkisofs_V)) {
       push(@MKISOFS, '-V', $mkisofs_V);
   }
   if (defined($mkisofs_other)) {
       push(@MKISOFS, split(' ', $mkisofs_other));
   }

   $Append = 0 if ($first_session);
}

# ------------------------------ MNI Header ----------------------------------
#@NAME       : CreateInfoText
#@INPUT      : 
#@OUTPUT     : 
#@RETURNS    : 
#@DESCRIPTION: 
#@METHOD     : 
#@GLOBALS    : 
#@CALLS      : 
#@CREATED    : 98/11/29, Alex Zijdenbos
#@MODIFIED   : 
#-----------------------------------------------------------------------------
sub CreateInfoText
{
    $Usage = <<USAGE;
Usage: $ProgramName [options] [<dir> ...]
       $ProgramName -help for details
USAGE

    $Help = <<HELP;

$ProgramName
wrapper around mkisofs and cdrecord, typically creating multi-session
CDs. The file system is typically created with both Rock Ridge and Joliet
extensions.
   Host-specific settings can be specified on the command line, or in
a file called cdroast.conf. $ProgramName will look for this file in
. ~ ~/etc /etc, in this order; entries in this file should be a line
for each supported host, containing 6 values:

   <hostname>   <dev>   <mountdev>   <cdrom>   <imagedir>   <speed>

IMPORTANT NOTES:
    1) The arguments should be directories. The behaviour of mkisofs is
       unreliable for writing single files in a multi-session CD. To write
       a single file, put it in a subdirectory (by itself), and then pass
       that directory as an argument to $ProgramName.
    2) Appending to a multi-session CD (the default behaviour) essentially
       overlays the new directory structure on the existing organization
       of the disk. Any existing files/directories by the same name will either
       be hidden - or will cause mkisofs to crash. If you intend to overlay 
       identical files or directories onto an existing image, you should
       (as of mkisofs 1.12b5) forego Joliet extensions by specifying -joliet.
       Note that this will likely make your CD unreadable under Windoze.
    3) When using -copy, the user is responsible for specifying -erase when
       necessary. Note also that this will not create a multi-session CD.
    4) When using -create_image, the user is responsible for assuring that
       there is sufficient space for the disk image available in the image
       directory (default: $ImageDir).
HELP

   Getopt::Tabular::SetHelp ($Help, $Usage);
}

sub ParseConf
{
    my($confdirs, $confname, @values) = @_;
    my($curhost) = hostname();

    # Locate configuration file
    my($confdir) = shift @$confdirs;
    my($conf) = "${confdir}/${confname}";
    while (! -e $conf && defined($confdir = shift @$confdirs)) {
      $conf = "${confdir}/${confname}";
    }
    return if (! -e $conf);
    
    my($fh) = new IO::File $conf;
    die ("Couldn't read $conf: $!") if (! defined $fh);
    
  LINE:
    while (<$fh>) {
      next LINE if ((/^\s*\#/) || (/^\s+$/));
      my(@newvalues) = split;
      die "Error reading $conf; entries must have 6 values\n" if (@newvalues != 6);
      
      my($host) = shift @newvalues;
      
      if (($host eq '*') || ($curhost =~ /^$host/)) {
	foreach my $i (0..4) {
	  ${$values[$i]} = $newvalues[$i];
        }  
        return if ($host ne '*' && $curhost =~ /^$host/);
      }
    }
}

sub UniqueImageFile
{
    my($dir) = @_;

    my($unique) = "${dir}/image.iso";
    my($i) = 0;
    while (-e $unique) {
	$i++;
	$unique = "${dir}/image${i}.iso";
    }
    
    $unique;
}

sub Stringify {
    my($list) = @_;
    my($string) = '';
    
    my($token);
    foreach $token (@$list) {
	$string .= ($token =~ / /) ? "\'${token}\' " : "${token} ";
    }

    chop $string;

    return $string;
}

sub ReloadSCSI {
    # Work around bug in ide-scsi (?) by reloading the module
    my $result;
    Spawn(['lsmod'], stdout => \$result);
    if ($result =~ /ide-scsi/) {
	Spawn(['sudo', '/sbin/rmmod', 'ide-scsi'], err_action => 'ignore');
	Spawn(['sudo', '/sbin/insmod', 'ide-scsi'], err_action => 'ignore');
    }
}