#!/usr/athena/bin/perl -w

use strict;
use 5.8.0;
use Getopt::Long          qw(GetOptions);

# Goal: to let you connect to shares in MIT's DFS filespace.
# 
# Without this wrapper, you have to run smbclient once,
#  read the error message, and then re-run smbclient with
#  options that incorporate text from the error.  For example:
#
## $ smbclient -k //win.mit.edu/dfs -D /profiles/j/jmorzins
## Connection to profiler3.mit.edu\homes3$ failed
## Unable to follow dfs referral [//profiler3.mit.edu\homes3$/j]
##
## $ smbclient -k //profiler3.mit.edu/homes3\$ -D /j/jmorzins
## smb: \j\jmorzins\> 
#
# With the wrapper, you can just run one command:
#
## $ dfsclient /profiles/j/jmorzins
#
# The leading //win.mit.edu/dfs is optional, and can be omitted.
# The wrapper will automatically run "smbclient -k //.../... -D /./..."
# The wrapper will also include any other command line arguments given.

use subs qw(usage debug validate_unc_path probe_referral);

my $debug = 0;
&main;

sub main {

  while ( defined($ARGV[0]) and $ARGV[0] =~ /^-/ ) {
    if ( $ARGV[0] =~ /(-h|-\?|--help)/ ) {
      shift @ARGV;
      usage;
      # exits...
    }
    elsif ( $ARGV[0] =~ /(--debug)/ ) {
      shift @ARGV;
      $debug++;
    }
  }

  my $unc_path = ( shift(@ARGV) or usage );

  my $file_path = validate_unc_path($unc_path);
  my $unc_share = '//win.mit.edu/dfs';

  my $dfs_share;
  my $dfs_path;

  debug "Probing for a DFS referral...\n";
  debug "+ smbclient -k $unc_share -D $file_path\n";
  ($dfs_share, $dfs_path) = probe_referral($unc_share, $file_path);
  debug "+ smbclient -k $dfs_share -D $dfs_path\n";
  exec("athrun", "samba", "smbclient", "-k", $dfs_share, "-D", $dfs_path, @ARGV);
}

sub usage {
  my $user = $ENV{"USER"};
  my $u = substr $user, 0, 1;
  print "Usage: dfsclient /profiles/$u/$user\n";
  print "       dfsclient [--debug] <path> [smbclient options]\n";
  exit 1;
}

sub debug {
  if ($debug) {
    print STDERR @_;
  }
}

# If unc_path starts with //win.mit.edu/dfs, trim it off.
# If unc_path starts with //generic-host/share, raise an error.
# Also fix leading slash
sub validate_unc_path ($) {
  my $unc_path = shift;
  # test for //host/share
  if ( $unc_path =~ m,^[\\/]{2}[^\\/]+[\\/][^\\/]+, ) {
    # test for //win.mit.edu/dfs
    if ( $unc_path =~ m,^[\\/]{2}win\.mit\.edu[\\/]dfs([\\/]|$),i ) {
      # Remove up to and including the "dfs"
      $unc_path =~ s,^[\\/]{2}win\.mit\.edu[\\/]dfs,,i;
    } else {
      &usage;
    }
  }

  # Add leading / (if necessary).
  $unc_path =~ s,^/?,/,;
  return $unc_path;
}


# probe_referral:
# - open smbclient to the initial \\server\share\file_path
# - parse the error message
#  + figure out where the dfs referral is
#  + figure out which component of file_path to start from in the dfs referral
# - return the new dfs_share and dfs_path to our caller.
sub probe_referral ($$) {
  my $unc_share = shift;
  my $file_path = shift;
  my $dfs_share = "";
  my $dfs_path = "";
  my @output;

  open KID_PROCESS, "-|",
    "athrun", "samba", "smbclient", "-k", $unc_share, "-D", $file_path, "-c", "quit"
      or die "Error, couldn't probe smbclient: $!";
  @output = <KID_PROCESS>;
  close KID_PROCESS;

# kamp-krusty{1461}$ smbclient -k //win.mit.edu/dfs -D ops/scripts/common
# OS=[Windows Server 2003 3790 Service Pack 1] Server=[Windows Server 2003 5.2]
# Connection to 24dfs1.mit.edu\auto\operational failed
# Unable to follow dfs referral [//24dfs1.mit.edu\auto\operational/scripts]
# cd \ops\scripts\common\: NT_STATUS_PATH_NOT_COVERED

  foreach (@output) {
    if (m,
	^Unable\s+to\s+follow\s+dfs\s+referral\s+
	\[
	([\\/]{2}[^\\/]+[\\/][^\\/]+) # //24dfs1.mit.edu\auto
	((?:[\\/][^\\/]*)+)	      # \operational/scripts
	\]$
	,x ) {
      $dfs_share = $1;
      $dfs_path = $2;
      last;
    }
  }

# For each successive path component in $file_path,
# test the last path component of $dfs_path.
# (e.g: $file_path="/ops/scripts/common" and $dfs_path="\operational/scripts"
#       compare "ops"     to each of "operational","scripts".
#       compare "scripts" to each of "operational","scripts".)
# If they match, append the remaining part of the filepath onto the dfs_path.


  if ( $dfs_share ne "" and $dfs_path ne "" ) {
    my (@filepaths) = split(m{[\\/]}, $file_path);
    # The split will produce a leading empty field.  Remove it.
    @filepaths = grep (/./, @filepaths);
    my (@dfspaths) = split(m{[\\/]}, $dfs_path);
    @dfspaths = grep (/./, @dfspaths);
    my ($source, $dest);
    debug "Something in $file_path referred to $dfs_share$dfs_path...\n";
    while ($source = shift @filepaths) { # it is important to have a remainder
      foreach $dest (@dfspaths) {
	debug "Considering $source vs $dest\n";
	if ($source eq $dest) {
	  # append remaining filepath onto dfs_path
	  $dfs_path = join("/", $dfs_path, @filepaths);
	  return ($dfs_share, $dfs_path);
	}
      }
    }
  }
  return ($unc_share, $file_path);    # old values
}