#!/usr/bin/perl

use strict;
use Getopt::Std;
use IO::File;

my $prog = $0;
$prog =~ s:.*/::;

my $Usage = "Usage: $prog [-c] [-l o=n[,..]] [-s] file.lnk [...]
	-s	Set stupid bit in link files (means link is not to use
		host/share path - just drive letter path).
	-c	Check links for missing stupid flag and for references
		to C:, D: and E drives - does not modify the link files.
	-l orig-let=new-let[,...]
		Define the drive letter substitutions: eg, C=F,D=X
		means change C: to F: and change D: to X:.
		Default is C=F.
    Changes (or checks for) C: drive letters in .lnk files to F: and
    (if -s flag given) sets the `stupid' bit.
";

my %opt;
if (!getopts('cl:s', \%opt)) {
    die $Usage;
}

my $check = defined $opt{'c'} ? 1 : 0;
my $setStupid = defined $opt{'s'} ? 1 : 0;
my %letterMap = ( 'C' => 'F' );
# Default is to check for all drives (eg, cdroms)
if ($check) {
    # Arbitrary targets
    $letterMap{'D'} = 'G';
    $letterMap{'E'} = 'H';
}
if (defined $opt{'l'}) {
    %letterMap = ();
    my($map, $o, $n);
    foreach $map (split(',', $opt{'l'})) {
	if ($map !~ /^([a-zA-Z])=([a-zA-Z])/) {
	    die "$prog: bad letter maping (-l argument): $opt{'l'}\n";
	}
	($o, $n) = ($1, $2);
	if (defined $letterMap{$o} && $letterMap{$o} ne $n) {
	    die "$prog: bad letter maping: multiple mappings for drive $o\n";
	}
	$letterMap{$o} = $n;
    }
    foreach $n (values %letterMap) {
	if (defined $letterMap{$n}) {
	    die "$prog: letter map changes are circular (will produce undefined results)\n";
	}
    }
}

die "$prog: no link files specified\n$Usage" if @ARGV == 0;


my $file;
foreach $file (@ARGV) {
    if ($file !~ /\.lnk$/i) {
	print STDERR "$prog: $file: not a .lnk file\n";
	next;
    }
    my $size = -s $file;
    if (!defined $size) {
	print STDERR "$prog: can't stat $file - $!\n";
	next;
    }
    my $fh = new IO::File($file, $check ? "r" : "r+");
    if (!defined $fh) {
	print STDERR "$prog: can't open $file - $!\n";
	next;
    }
    my $info = '';

# Make the lnk stupid.
    if ($setStupid) {
	my $byte = "\0";
	if (!seek(LNK, 0x15, 0)) {
	    print STDERR "$prog: can't seek to flag byte in $file - $!\n";
	    next;
	}
	if (read(LNK, $byte, 1) != 1) {
	    print STDERR "$prog: can't read flag byte from $file - $!\n";
	    next;
	}
	if (!(ord($byte) & 0x1)) {
	    if ($check) {
		$info .= ", is smart";
	    } else {
		$byte = chr(ord($byte) | 0x01);
		seek(LNK, 0x15, 0);
		print LNK $byte;
	    }
	}
	if (!seek(LNK, 0, 0)) {
	    print STDERR "$prog: can't rewind $file - $!\n";
	    next;
	}
    }

# Now scan for all occurrances of C:\ */
    my $buf = '';
    if (read(LNK, $buf, $size + 1) != $size) {
	print STDERR "$prog: unexpected read value in $file - $!\n";
	next;
    }
    if ($check) {
	foreach (keys %letterMap) {
	    if ($buf =~ /$_:\\/i) {
		$info .= ", refers to $_:";
	    }
	}
    } else {
	my ($o, $n);
	while (($o, $n) = each %letterMap) {
	    $buf =~ s/$o:\\/$n:\\/gi;
	}
	seek(LNK, 0, 0);
	print LNK $buf;
    }

    if ($check && $info ne '') {
	$info =~ s/^, //;
	print "$file $info\n";
    }

    if (!close(LNK)) {
	die "$prog: error closing $file - $!\n";
    }
}
