#! /usr/bin/perl

#	"Hook" for situation-dependent actions for PCcard devices.

#	Original catalyst was the desire to be able to have an Ethernet
#	(wireless -- 802.11b -- actually) be able to be used in either
#	of a couple of environments.

#	The general idea is that we use a couple of text files as (primitive)
#	"databases".  (Ref. ftp://ftp.rand.org/pub/RDB-hobbs/.)  One of
#	them, loc.db, is the "location" database:  its purpose is to
#	specify what locations exist and what "stuff to try/set" in each
#	location.  The other, kwd.db, is used as an aid in translating
#	the (relatively) abstract concept of "what to do in a given
#	location" that is in loc.db to the concrete "how do I do this for
#	this device" -- the idea here being that I might use an Aironet/Cisco
#	card one time, and a Lucent/WaveLAN/Orinoco card the next, but
#	the effective *function* is intended to be equivalent.

#	Note that it is OK for there to be multiple entries in loc.db
#	with the same "Loc" tag, but different "Type" tags.  The code
#	looks for applicable entries based on "Type", and builds the
#	list of locations to check based on this.

$ENV{'PATH'} = "/usr/bin:/bin:/sbin:/usr/sbin";

use Getopt::Std;

&getopts("dD:f:i:l:n:Tx");
# d     if specified, debug to STDERR.
# D     database directory (default: /usr/local/etc/pccard)
# f     file for tracking the usage patterns, as a hint to the ordering
# i     interface on whose behalf we're doing this
# l	override the searching heuristics and just use the specified loc
# n	number of times to go through the list (default 5)
# T	test -- merely report what would (otherwise) have been done
# x     if specified, use the "experimental" (-exp) entry

my($me) = "$0";
$me =~ s/^.*\///;

exit 0 if (-f "/tmp/.monitor");

if ($opt_d) {
  if (! $opt_T) {
    open(STDERR, ">/var/log/$me") || die "$me: Can't open log: $!\n";
  }
  print STDERR "$me: Starting at " . scalar(localtime) . "\n";
}

my($iface) = "$opt_i" || die "$me: Usage \"$me -i interface\"\n";
my($idrvr) = "$iface";
$idrvr =~ s/\d+$//;
$idrvr .= "-exp" if ($opt_x);
my($dir) = "$opt_D" || "/usr/local/etc/pccard";
print STDERR "$me: Interface $iface; driver $idrvr; rdb_dir $dir\n" if ($opt_d);
my($max_loops) = $opt_n || 5;

my(%rdb);
my(@kwd_fn) = &read_rdb("Driver", "${dir}/kwd.db");
my(%kwd_rdb);
foreach (@kwd_fn) {
  $kwd_rdb{"$_"} = "${${rdb{$idrvr}}[$[]}{$_}";
}
sleep(5);		# Let the card stabilize a bit before doing anything
my($type) = "$kwd_rdb{Type}";
print STDERR "$me: Iface type is $type; max_loops is $max_loops\n" if ($opt_d);
undef(%rdb);
my(@loc_fn) = &read_rdb("Loc", "${dir}/loc.db");

my($loc, %locs);
foreach $loc (keys(%rdb)) {
  print STDERR "$me: Checking location $loc\n" if ($opt_d);
  next if ("$opt_l" && ("$opt_l" ne "$loc"));
  my($itype, %m_loc);
  foreach $itype (@{${rdb{$loc}}}) {
    if ("$type" eq ${$itype}{Type}) {
      %m_loc = %{$itype};
      break;
    }
  }
  next unless (%m_loc);
  print STDERR "$me: Setting up location $loc\n" if ($opt_d);
  my(@cmds, $c_list, $fn);
  my($ifkw) = sprintf("$kwd_rdb{Iface}", "$iface");
  foreach $fn (@loc_fn) {
    my($val) = "$m_loc{$fn}";
      $locs{"$loc"}{"$fn"} = "\'$val\'";
    if ("$fn" eq "SSID") {
    } else {
      $locs{"$loc"}{"$fn"} = "$val";
    }
  }
  print STDERR "$me: Got info for location $loc:\n" if ($opt_d);
  foreach $fn (split(/\s+/, $kwd_rdb{Cmds})) {
    my($val) = "$locs{$loc}{$fn}";
    if (("Mode" eq "$fn") && (defined($kwd_rdb{$val}))) {
      my($arg) = "$kwd_rdb{Program} $ifkw $kwd_rdb{$val}";
      push(@{$locs{"$loc"}{"cmds"}}, "${arg}");
      $arg = "$kwd_rdb{Program} $ifkw [suppressed]" if ("Key" eq "$fn");
      push(@{$locs{"$loc"}{"pcmds"}}, "${arg}");
      $c_list .= "$fn ";
      print STDERR "$me:   $fn ${arg}\n" if ($opt_d);
      next;
    }
    if (defined($val) && ("$val" ne "") && defined($kwd_rdb{$fn})) {
      my($pcmd) = my($cmd) = sprintf("$kwd_rdb{$fn}", "$val");
      $pcmd = sprintf("$kwd_rdb{$fn}", "[suppressed]") if ("Key" eq "$fn");
      my($arg) = "$kwd_rdb{Program} $ifkw $cmd";
      push(@{$locs{"$loc"}{"cmds"}}, "${arg}");
      $c_list .= "$fn ";
      print STDERR "$me:   $fn ${arg}\n" if ($opt_d);
    }
  }
  print STDERR "$me: Got commands for $c_list\n" if ($opt_d);
}

my($chk) = "$kwd_rdb{Program} $kwd_rdb{Status}";
print STDERR "$me: Scanning output of \"$chk\" for /$kwd_rdb{Check}/\n" if ($opt_d);

my($def_loc);

my(@k) =  sort sort_locs keys(%locs);
print STDERR "$me: Location order is:\n\t" . join("\n\t", @k) . "\n" if ($opt_d);
while(--$max_loops || ($max_loops < 0)) {
  foreach $loc (@k) {
    exit 0 if (&try_loc("$loc"));
  }
}

print STDERR "$me: Failed to find a location\n" if ($opt_d);

exit 1;

sub read_rdb {
# Input is a path to file (of RDB format) and a fieldname to expect to
# be able to use as a "key."  Ensures that the %rdb hash is cleared, then
# set to match the content of the RDB file.  Returns list of fieldnames;
# %rdb will be a hash with the structure:
# $rdb{$key} ==> per-record list (for each key value present in the file);
# each per-record list will be an array of 1 or more hashes (more in the
# case of collisions on key value), where each list element will be a
# hash using fieldnames as keys.
# Returns list of fieldnames.

  my($keyname) = shift;
  my($path) = shift;
  my($data_line) = 0;
  my($ctr, $rec, @H, @F, @rdb_out_fields);
  undef %rdb;
  if (!open(RDB, "<$path")) {
    $msg = "550 Can't open file \"$path\": $!";
    exit 0;
  }
  while (<RDB>) {
    next if (($data_line < 1) && /^\s*#/);
    chop;
    $data_line++;
    (@F) = split("\t");
    if ($data_line == 1) {		# Field names....
	@rdb_out_fields = @H = @F;
	next;
    } elsif ($data_line == 2) {		# Field widths....
	next;
    } else {
      undef($rec);
      foreach (@H) {
        $rec->{$_} = shift(@F);
      }
      my($key) = $rec->{$keyname};
      push(@{$rdb{$key}}, $rec);
    }
  }
  close(RDB);
  return(@rdb_out_fields);
}

sub try_loc {
# Argument is a location (in the form of a key to the %locs hash).  Returns
# 0 if it didn't seem to work; !0 if it seemed to.  Issues the various
# commands for the location & device in question as a side-effect.

  my($loc) = shift;
  my($now) = scalar(localtime);
  print STDERR "$me: Testing location $loc at $now\n" if ($opt_d);
  my($ctr);
  my(@cmds) = (@{$locs{"$loc"}{"cmds"}});
  my(@pcmds) = (@{$locs{"$loc"}{"pcmds"}});
  for ($ctr = $[; $ctr <= $#cmds; $ctr++) {
    my($cmd) = "$cmds[$ctr]";
    my($pcmd) = "$pcmds[$ctr]";
    if ($opt_T) {
      print STDERR "$me: Would have issued \"$pcmd\"\n";
    } else {
      print STDERR "$me: Issuing \"$cmd\"..." if ($opt_d);
      system("$cmd");
      my($rc) = $? >> 8;
      print STDERR " ...got RC $rc\n" if ($opt_d);
      if ($rc) {
        print STDERR "$me: Got bad RC $rc from $pcmd; bailing....!\n";
        exit $rc;
      }
    }
  }
  # Wait a bit, depending on the location.
  my($sleep) = $locs{$loc}{Time};
  sleep($sleep);
  print STDERR "$me: Slept for $sleep seconds\n" if ($opt_d);
  open(TEST, "$chk |") || die "$me: Couldn't open pipe from \"$chk\": $!\n";
  while (<TEST>) {
    next unless (eval("/$kwd_rdb{Check}/"));
    chomp;
    print STDERR "$me: Got \"$_\"\n" if ($opt_d);
    my($ok) = "$locs{$loc}{Mode}" . "_OK";
    if (eval("/$kwd_rdb{$ok}/")) {
      if ($opt_d) {
        print STDERR "$me: Found location $loc";
	print STDERR " (ignoring because of test mode)" if ($opt_T);
	print STDERR "\n";
      }
      close(TEST);
      return $opt_T? 0: 1;
    } else {
      print STDERR "$me: Didn't match $kwd_rdb{OK};\n" if ($opt_d);
      break;
    }
  }
  close(TEST);
  return 0;
}

sub sort_locs {
# Sort function, specifically for the %locs hash.  Sorts in descending
# order, currently by the "Pref" field.

  return(($locs{$b}{Pref} <=> $locs{$a}{Pref}) || ($a cmp $b));
}