#!/usr/bin/suidperl -wU
# (c) 1999 by St. Traby <stefan@sime.com>
# (c) 1999 by KW-Computer Graz Austria
#
# use this in secure environments only. You can burn _any_ file maching
# the following regexp /\.iso$/ if also /\.txt$/ with the same
# basename exists.
#
# Handles also prepared ISO-images. They can also be accessed over SMB
# by loop mount because this script creates a SMB include file
# and an automounter (autofs) script...
#
# Just copy a iso9660 image to $imgdir (extension must be .iso) and
# create a small text file (same basename, extension must be .txt) that
# gives a single line description of the image. 
#
# no, NT can't do that. :)
#
# does notify the user by windows messaging if and only if the hostname
# equals the netbios name and the machine is in the same NT-domain.
#
# ok sorry, the rest is in german.
#


my $myid = '$Id: cdrecord.cgi,v 1.4 1999/11/25 12:15:23 stefan Exp $';

use strict;
use English;
use CGI::Carp qw(fatalsToBrowser);
use CGI qw(:standard :html3);
use POSIX;
# use MD5;
use Net::hostent;

my $logfile = "/var/log/cdrecord.log";
my $eject = "/usr/bin/eject";
my $nice = "/bin/nice";
my $dd = "/bin/dd";

my $reader = "/dev/scd0";
my $writer = "/dev/scd1";
my $writer_id = "0,6,0";
my $cdrecord = "/opt/schily/bin/cdrecord";
my $imgdir = "/usr/cdimages";

my $autofs = "/etc/auto.img";
my $smb = "/etc/smb.conf.iso";
my $autodir = "/cdrom-server";

sub update_autofs_and_samba {
    my $desc;
    my @lines = { };
    my @smb = { };
    my ($i,$ii) = (0,0);
    my $bn;
    my $t;

    for (<$imgdir/*.txt>) {
	my $img = $_;
	$img =~ s/\.txt$/.iso/;
	next if ! stat $img;
	open O, "<$_";
	$desc = <O>; close O; chomp $desc;
	my $bn = $img;
	$bn =~ s/\.iso$//;
	$bn =~ s@([^/]*)$@@;
	$bn = $1;
	$t  = $bn . " -fstype=iso9660,ro,loop :$img";
	$lines[$i++] = "# $desc";
	$lines[$i++] = $t;

	$smb[$ii++] = "[$bn]";
	$smb[$ii++] = "comment = $desc";
	$smb[$ii++] = "path = $autodir/$bn";
	$smb[$ii++] = "read only = yes\npublic = yes\n guest ok = yes";
    }
    unlink $autofs;
    open O, ">$autofs" or die "autofs $?";
    print O "# Created by $myid\n# (c) 1999 by St. Traby\n";
    for(my $j = 0; $j < $i; $j++) {
	print O "$lines[$j]\n";
    }
    print O "# EOF\n";
    close O;

    unlink $smb;
    open O, ">$smb";
    print O "# Created by $myid\n# (c) 1999 by St. Traby\n";
    for(my $j = 0; $j < $ii; $j++) {
	print O "$smb[$j]\n";
    }
    print O "# EOF\n";
    close O;
}



my $pid = &getpid;

sub do_send {
    my $msg = shift;
    my $remname = gethost(remote_host())->name;
    $remname =~  s/\..*//;
    
    open O, "|/usr/bin/smbclient -M $remname &>/dev/null";
    print O $msg;
    close O;
}

sub do_log {
    my $msg = shift;
    my $da = `date`;
    my $r = remote_host();
    $r = "$r (" . gethost($r)->name . ")";
    chomp $da;
    open O, ">>$logfile";
    chmod 0600, $logfile;
    chomp $msg;
    print O "$da $msg\n";
    close O;
}

sub my_bottom {
    print <<EOF
<HR>
 <ADDRESS>
  Last Updated: $myid
 </ADDRESS>
(c) 1999 by KW-Computer, written by <A HREF="mailto:stefan.sime.com">
St. Traby</A>
<HR>
</BODY></HTML>
EOF
}
sub my_exit {
    my $rc = shift;

    system($eject, $writer);
    if(!$rc) {
	do_send "CD-ROM Erstellung erfolgreich beendet.";
	exit(0);
    }

    do_send "Fehler bei der CD-Erstellung...";
    system($eject, $reader);
    exit(1);
}

sub burn {
    my $img = shift;

    setsid;
    foreach (qw(INT HUP PIPE TERM)) {
	$SIG{$_} = '';
    }

    if($img eq "erase") {
	system($eject, "-t", $writer);
	sleep(5);
	open IN, "$nice --17 $cdrecord dev=$writer_id blank=fast 2>&1|";
	while(<IN>) {
	    do_log $_;
	}
	my $m = "CD-RW erfolgreich gelöscht.";
	do_log $m;
	do_send $m;
	close IN;
	exit 0;
    }

    my $i = 0;
    while($i < 2) { 	
	system($eject, "-t", $reader) if $img eq "copy";
	system($eject, "-t", $writer);
	sleep 1;	
	++$i;
    }
    sleep 5;
    $img = $reader if $img eq "copy"; # hehe
    setpriority 0, $pid, -15;
    open IN,  "$nice --16 $dd if=$img conv=block bs=64k 2>/dev/null |";
    open OUT, "|$nice --17 $cdrecord fs=6m dev=$writer_id speed=6 - >$logfile 2>&1";
    my $rc;
    my  $buf;
#    my $md5 = new MD5;
    while(($rc = sysread(IN, $buf, 1024*64)) > 0) {
#	$md5->add($buf);
	syswrite(OUT, $buf, $rc);
    }
    close OUT;
    close IN;
#    my $dig1 = $md5->digest();
#    do_log "Verifying CD-Contents...";
#    $md5->reset;
#    open IN, "$dd if=$writer conv=block bs=64K 2>/dev/null |";
#    while(($rc = sysread(IN, $buf, 1024*64)) > 0) {
#	$md5->add($buf);
#    }
#    close IN;
#    my $dig2 = $md5->digest();
#    if($dig1 eq $dig2) {
#	do_log "Verify successful.";
#	my_exit 0;
#    } else {
#	do_log "Verify **not** successful, contents differ.";
#	my_exit 1;
#    }
    do_log "CD kopiert...";
    my_exit 0 # never reached.
}

sub first_page {
    my $msg1 = <<'EOF';
 <HEAD>
  <TITLE>KWC CDROM Copy, ein Meisterwerk von Stefan Traby</TITLE>
 </HEAD>
 <BODY  BGCOLOR="#FFFFFF" TEXT="#000000" LINK="#0000FF"
     VLINK="#000080" ALINK="#FF0000" >
  <H1 ALIGN="CENTER">Wir kopieren wiedereinmal CD-ROMs</H1>
  <HR>
  Bitte führe die Quell-CD, die Du kopieren willst, in<BR>
  mein unteres CD-Laufwerk ein und<BR>
  die leere Ziel-CD - die Du beschreiben möchtest - in mein<BR>
  oberes CD-Laufwerk ein<BR><BR>
  Hmm, damit Du weißt, ob der Schreibvorgang erfolgreich war,<BR>
  betrachte mich einfach <BR><BR>
  Ist <EM>keine</EM> CD <EM>ausgeworfen</EM>, so <EM>arbeite</EM> ich noch<BR>
  Ist die <EM>obere (Ziel-CD) ausgeworfen</EM>
  und die <EM>untere nicht</EM>,<BR>
  so konnte ich die CD <EM>fehlerfrei</EM> kopieren.<BR>
  Sind <EM>BEIDE</EM> CD-ROMs <EM>ausgeworfen</EM>,
  so trat ein <EM>FEHLER</EM> beim Schreiben auf -<BR>
  die obere CD kannst Du dann dem Sondermüll zuführen.<BR>
  <BR><HR>
  Ich versuche auch, Dir eine Meldung über den Windows Nachrichtendienst<BR>
  zu schicken, aber bekanntermaßen funktioniert das bei Windows nicht immer<BR>
  (Was funktioniert bei Windows eigentlich ??)<BR>
<HR>
  So, jetzt lege die beiden CD-ROMs ein und<BR>
  <P><a href="/cgi-bin/cdrecord.cgi?isoimage=copy">Starte den Kopiervorgang</a><p><BR>
EOF
    my $first = 0;
    my $msg2 = "";

    for (<$imgdir/*.txt>) {
	my $i = $_;
	$i =~ s/\.txt$/.iso/;
	next if ! stat $i;
	open O, "<$_";
	my $t = <O>; close O; chomp $t;

	$msg2 .= "oder lege nur eine leere CD oben ein und<BR>\n"
	    if ! $first++;
	
	$msg2 .=  "<P><a href=\"/cgi-bin/cdrecord.cgi?isoimage=$i\">erstelle eine $t</a>\n";
    }


    my $msg3 = <<'EOF';
  <BR><BR>
  oder gehe zurück zum <a href="http://fast.kwc.at/">Hauptmenü</a><BR>
<HR>
PS.: Ich bin der coole Linux-Server der in der Werkstatt der unter<BR>
dem komischen Verteilerkasten steht. Also rein in die Werkstatt und<BR>
geradeaus gehen...<BR><BR>
PS2: Quell-CD unten<BR>
PS3: leere Ziel-CD oben<BR>
PS4: Du darfst mich auch streicheln...<BR>
PS5: Wenn Du eine Master-CD erstellen willst, klicke <a href="/cgi-bin/cdrecord.cgi?isoimage=master">hier</a><BR>
PS6: Wenn Du eine wiederbeschreibbares CD-RW Medium löschen willst, so
klicke <a href="/cgi-bin/cdrecord.cgi?isoimage=erase">hier</a><BR>
EOF

    print "$msg1 $msg2 $msg3";
    &my_bottom;
}

sub do_fork {
    my $pid;
    if(($pid = fork())) {
	print h2("Ich starte nun, baba.");
	my_bottom;
	exit 0;
    } else {
	close STDIN;
	close STDERR;
	close STDOUT;
    }	
}

sub checkISOFile ($) {
  my $iso = shift;
  my $txt;

  return 0 if ! defined $iso;
  $_ = $iso;
  return 0 if ! /\.iso$/;
  ($txt = $iso) =~ s/\.iso$/.txt/;
  return 0 if ! stat($iso) ;
  return 0 if ! stat($txt) ;

  1;
}


sub main {
  my $iso = undef;
    print header(-expires => 'now');
    eval "&update_autofs_and_samba;";

#    print "EUID = $EUID, UID = $UID, EGID = $EGID, GID = $GID";
  $iso = param('isoimage') if param() && defined param('isoimage');

    if(!param() || ! defined $iso || (! checkISOFile($iso)
     && $iso ne "copy" && $iso ne "master" &&
	$iso ne "erase")) {
	first_page();
	exit 0;
    }

    if(param('isoimage') eq "master") {
	print h3("Sorry, access denied.");
	print "Der Zugriff wurde verweigert, vielleicht bist Du<BR>" .
	    "einfach nicht geistig reif genug, um CD's zu mastern.";
	my_bottom;
	exit(0);
    }

    &do_fork;
    exit burn(param('isoimage'));
}

&main;