#!/usr/bin/perl -w
#
# $Id: wifilinkup,v 1.10 2006/11/18 19:54:17 tomj Exp $
#
#
# __ ___ _____ _ _ _ _ _ _
# \ \ / (_) ___(_) | | (_)_ __ | | __ | | | |_ __
# \ \ /\ / /| | |_ | |_____| | | | '_ \| |/ /____| | | | '_ \
# \ V V / | | _| | |_____| |___| | | | | <_____| |_| | |_) |
# \_/\_/ |_|_| |_| |_____|_|_| |_|_|\_\ \___/| .__/
# |_|
#
# This manages the network link. It tries to keep the link up
# and associated to the best open AP available. It will run in
# the background and log to a file, or with a curses display.
#
# The rt25xx driver seems to cause kernel lock up problems,
# hopefully only when mpg321 is running. When ignition is on,
# we do no networking, but leave existing connections up.
# All network changes are done only when power is off.
use strict;
no strict 'refs';
use DBI;
use Curses;
use Getopt::Std;
use Term::ReadKey; # debug
my $wifi= "eth1"; # our wireless interface
my $logf= "wifi.log"; # out log file
my $dbfile= "./apdb.csv";
# Programs needed.
my $ifrenew= "sudo /sbin/ifrenew";
my $iwconfig= "sudo /usr/sbin/iwconfig";
my $iwlist= "sudo /usr/sbin/iwlist";
my $ifconfig= "sudo /sbin/ifconfig";
my $killall= "sudo /usr/bin/killall"; # rt2570 kludge
# Inter-program flag files.
my $pfflagfile= "IGNITION-OFF"; # power-off flag, set by radioplayer
my $netflagfile= "NETUP"; # network-up flag, to radioplayer
# ping:
# -w N deadline, seconds (exit regardless)
# -l N preload outgoing pings
# -c N if -w, wait for N replies
# returns 0 if response, 1 no replies, 2 error
my $ping="/bin/ping -c 1 -w 1 -l 1";
# netstat: make it return numeric table only.
# Kernel IP routing table
# Destination Gateway Genmask Flags MSS Window irtt Iface
# 128.195.166.128 0.0.0.0 255.255.255.192 U 0 0 0 eth0
# 169.254.0.0 0.0.0.0 255.255.0.0 U 0 0 0 eth0
# 127.0.0.0 0.0.0.0 255.0.0.0 U 0 0 0 lo
# 0.0.0.0 128.195.166.129 0.0.0.0 UG 0 0 0 eth0
my $netstat="/bin/netstat -rn";
# Various configurable items.
my $PING_THRESH= 20; # number of missed pings == link down
my $SCAN_TIME= 60; # maximum time to scan for APs
my $ASSOC_TIME= 30; # how long to wait for AP association
my $DHCP_TIME= 30; # how long to wait for DHCP to get an address
my $BACKOFF_TIME= 60; # how long to delay after failed association
# List these as channels please.
my %CHANNELS= (
"0" => "--",
"2.412" => "01",
"2.417" => "02",
"2.422" => "03",
"2.427" => "04",
"2.432" => "05",
"2.437" => "06",
"2.442" => "07",
"2.447" => "08",
"2.452" => "09",
"2.457" => "10",
"2.462" => "11",
"2.467" => "12",
"2.472" => "13",
"2.484" => "14",
);
# ---------------------------------------------------------------------------
# Global info on the current AP, filled in by various routines.
my $essid= ""; # current ESSID
my $chan= "0"; # current channel
my $gw= ""; # current gateway
my $ip= ""; # current interface address
my $Q= ""; # current link quality
my $wep= ""; # current WEP key requirement
my $ap= ""; # current AP MAC
my $assoc= 0; # current association flag
my %APs= (); # list of currently visible APs
my $missed_pings; # for checking link state
my $fg; # command line -f foreground
my $ignore_pf; # command line -g ignore power fail
my $debug;
my $timer1; # time we wait for an IP address
my $state; # state machine
my $power_off; # detects power fail
# Database interface functions using SQL interface do a CSV
# database.
my $NIL= "!NIL!"; # string we use to represent ""
# This determines the database record format. It's used to
# create the database, build query and write strings.
# The field sizes don't matter with CSV DB type; they are
# variable-length.
my %DBRECD = (
"ap" => 18, # chars in a MAC address
"essid" => 64,
"chan" => 2,
"wep" => 32,
"Q" => 3,
"time" => 16, # time stamp last access
"success" => 8, # associate successes
"fail" => 8, # associate failures
"score" => 8 # total score (for offline comparison)
);
my $FIELDORDER= "ap essid chan wep Q time success fail score";
my %db_cache= (); # active copy of DB record
my $dbfn= ""; # local copy of filename
my $dbpath= "./";
my $db_o= 0; # db open or not
my $db_dirty= 0; # cache needs writing to disk
my $dbh; # DB object
my $sth; # most-recent execute object
use vars qw/$opt_d $opt_h $opt_g $opt_l $opt_i $opt_f/;
getopts ('dghl:i:f');
&usage if defined $opt_h;
$logf= $opt_l if defined $opt_l;
$wifi= $opt_i if defined $opt_i;
$debug= defined $opt_d ? 1 : 0;
$ignore_pf= defined $opt_g ? 1 : 0;
$fg= defined $opt_f ? 1 : 0;
if ($fg) { initscr; clear; } # init curses
# Seed information for the first time through. Since we might
# already be connected, gather the information for display.
$missed_pings= 0;
$power_off= ($ignore_pf || -e $pfflagfile) ? 1 : 0;
&log("Startup, ignition " . ($power_off ? "off" : "on"));
&log("Assuming ignition off (-g)") if $ignore_pf;
$state= $power_off ? "1" : "0"; # determine initial state,
($Q, $essid, $chan, $ap, $assoc)= &getwifi(); # get wifi junk,
$gw= &getgw(); # get gateway,
$ip= &getmyip(); # get IP address,
&pinger(); # do one ping test,
&flagup() if &isup(); # flag net state,
&log (&isup() ?
"Startup \"$essid\" $ap Ch=$chan Q=$Q ip=$ip"
: "Startup, down");
while (1) {
$power_off= ($ignore_pf || -e $pfflagfile) ? 1 : 0;
sleep(1); # this is our loop timer!
# Debug crap.
if ($debug) {
my $c= ReadKey (-1);
$c= "" if not $c;
if ($c eq "q") { &db_close(); exit; }
if ($c eq "d") { &iwclear(); system ("sudo route delete default"); }
}
# This is the idle state, entered while ignition power is on.
# We switch to state 1 (normal operation) when the power-off
# flag file exists.
if ($state eq "0") { # ignition on, idle
$state= "12" if $power_off;
&display("Idle");
# Interface is up; simply watch it. If ignition goes on, we leave
# the interface up but don't ping or monitor it.
} elsif ($state eq "1") {
$state= "11" if not $power_off;
&pinger(); # send, listen pings
$Q= &wifiQ(); # get current link quality
&display ("Up \"$essid\" $ap Ch=$chan Q=$Q ip=$ip");
$state= "2" if &isdown(); # else remain state 1
# Interface is (went) down. Prepare to scan for APs. The rt2570
# driver is buggy, and hangs networking when accessed in some
# complicated way (eg. not associated, ifrenew running, then
# attempt iwscan), which I guess is the interface marked down
# (I found it that way various times).
} elsif ($state eq "2") {
$state= "11" if not $power_off;
&display("Down");
&log("Down");
unlink ($netflagfile); # net is down
&db_open($dbfile); # we will need this
if ($wifi =~ /^rausb/) { # KLUDGE!!
&log ("rt2570 kludge");
system ("$killall dhcpcd"); # is this needed
sleep (5); # await dhcpcd stop?
system ("$ifconfig $wifi down"); # must be up!
sleep (5); # await dhcpcd stop?
system ("$ifconfig $wifi up"); # must be up!
}
# iwclear needed?
&iwclear(); # not associated
%APs= (); # clear visible AP list
$timer1= time + $SCAN_TIME;
$state= "3";
# Wait until we see one or more APs. For a given list of visible APs,
# we make associate/connect attempts on each one until
# success or we timeout (timer1).
#
# Note that this bounces between state 3 and 3a; the only purpose
# of this is to slow down the rate of scanning to once per two
# seconds. I suspect that there are rt2570 problems scanning, maybe
# they are stacking up?
} elsif ($state eq "3") {
$state= "11" if not $power_off;
&iwscan(); # make list of APs,
&display("Scanning", &listAPs());
my $n= scalar (keys (%APs)); # number of APs found
if ($n > 0) { # found AP(s)
$timer1= time + (($n + 1) * $ASSOC_TIME);
$state= "4"; # go associate
} elsif (time > $timer1) { # taking too long,
&log ("Scanning, timed out");
$state= "13"; # back off,
} else {
&log ("Scanning, no APs found");
$state= "3a"; # delay one cycle,
}
} elsif ($state eq "3a") {
$state= "3"; # delays one loop time,
# Choose the best AP from the list and try to associate with it.
} elsif ($state eq "4") {
$state= "11" if not $power_off;
my $e= &associate(); # choose an AP,
if ($e) { # if we got one,
&display("Associate with \"$e\"", &listAPs());
$timer1= time + $ASSOC_TIME;
$state= "5"; # await association
} else { # tried all in the list!
&display("No open APs", &listAPs());
&log("No open APs", &listAPs());
$state= "13"; # back off a while
}
if (time > $timer1) { # took too long!
&log ("Couldn't associate with any visible AP");
$state= "13"; # back off a while
}
# Await association. Iwconfig will tell us via getwifi().
} elsif ($state eq "5") {
$state= "11" if not $power_off;
$state= "5a" if time > $timer1; # never associated
($Q, $essid, $chan, $ap, $assoc)= &getwifi();
if ($assoc) { # succeeds
&display ("Associated with \"$essid\" $ap");
&log ("Associated with \"$essid\" $ap");
$state= "6"; # has associated
}
# Never associated. Delete this one from the list of APs and try another
# from the list of visible APs.
} elsif ($state eq "5a") {
&display ("Failed to associate with \"$essid\" $ap");
&log ("Failed to associate with \"$essid\" $ap");
&db_param("fail", &db_param("fail") + 1);
delete $APs{&db_param("ap")}; # don't try it again
$state= "4";
# Driver associated with an AP, request an address. Ifrenew
# will restart dhcpcd.
} elsif ($state eq "6") {
$state= "11" if not $power_off;
&display ("DHCP request");
&log ("Request IP address, gateway");
system("$ifrenew $wifi > /dev/null 2>&1 &");
$timer1= time + $DHCP_TIME;
$state= "7";
# From here down, we ignore ignition state; we're simply waiting
# for wifi DHCP data, with the assumption that this does not
# disrupt music nor cause lockups. All paths lead to state 1 or 2.
# The result is that the NETUP flag will be accurate even
# when ignition is on.
# Now we wait for an IP address. At this point we could try
# try other schemes to obtain (or assume) an IP address, and
# replace it with one obtained from DHCP, if one arrives, but
# for now just wait.
} elsif ($state eq "7") {
&display ("Await IP address");
$ip= &getmyip(); # get IP address,
$state= "8" if ($ip ne "");
$state= "10" if time >= $timer1;
# If ignition goes on from here on, don't automatically switch to
# idle state.
} elsif ($state eq "8") {
&display ("Await gateway");
$gw= &getgw(); # get gateway,
$state= "9" if ($gw ne "");
$state= "10" if time >= $timer1;
# We got an IP address; get ready to watch the network.
} elsif ($state eq "9") {
&display("Connected");
&log ("Connected \"$essid\" $ap Ch=$chan Q=$Q ip=$ip");
&db_param("success", &db_param("success") + 1);
&db_close(); # write out the DB.
$missed_pings= 0; # assume network OK,
&flagup(); # tell the world,
$state= "1";
# Never got IP and/or gateway; still down, start over.
} elsif ($state eq "10") {
&display ("Connection failed");
&log ("Connection failed");
&db_param("fail", &db_param("fail") + 1);
&db_close(); # write out the DB.
$state= "2";
# Ignition just went on; log that, close the database, switch to idle state.
} elsif ($state eq "11") {
&log("Ignition on, go idle");
&db_close();
$state= "0";
# Ignition just went off; switch to active state.
} elsif ($state eq "12") {
&log("Ignition off, go active");
$state= "1";
# Could not associate with any AP in the list; back off a while.
} elsif ($state eq "13") {
$state= "11" if not $power_off;
&log("No usable APs, backing off");
$state= "14";
} elsif ($state eq "14") {
$state= "11" if not $power_off;
$state= "2" if time > $timer1;
}
}
#############################################################
#
# $essid= &associate();
#
# Given a list of APs within range, choose one to associate with.
# The essid of the chosen one is returned (else "" if none).
#
# A score is generated for each of the APs in range; the AP with
# the highest score is chosen. Signal strength and previous association-
# attempt results are weighted.
sub associate {
my $bestAP= "";
my $bestscore= -99999999; # umm, fairly low
my $score;
foreach my $ap (keys %APs) {
my ($essid, $chan, $key, $Q)= split (/~/, $APs{$ap});
&db_get($ap); # find in the database,
# First generate a success-rating sub-score, total-tries / success,
# scaled 0 - 100, where 100 means always successful.
my $f= &db_param("fail");
my $s= &db_param("success");
# The simplest part of the score: success to failure ratio. We
# bump scores up slightly with success.
my $r= 1; # (if never tried...)
$r= $s / ($s + $f) if $s + $f; # runs 0 - 1
$r= int ($r * 100); # now runs 0 - 999
$r += $s; # tie-breaker: successes, good,
# WEP-locked APs rate badly, since we don't have any keys. Yet.
my $w= &db_param("wep") eq "open" ? 0 : -500;
$score= $r + $w + $Q; # total score
&db_param("score", $score); # remember it for history,
&log ("Score \"$essid\" r=$r (s=$s, f=$f) w=$w Q=$Q score=$score");
if ($score > $bestscore) { # if best so far,
$bestscore= $score;
$bestAP= $ap; # remember it
}
}
if (not $bestAP) {
&log ("No usable APs visible");
return "";
}
# Found one, of whatever score. Select it.
&db_get($ap= $bestAP); # get AP data,
$essid= &db_param("essid");
$chan= &db_param("chan");
&db_param("time", time);
# `$iwconfig $wifi essid \"$essid\" channel $chan 2>/dev/null`;
&log("Associate attempt with \"$essid\" $ap");
system("$iwconfig $wifi ap $ap");
# system("$iwconfig $wifi essid \"$essid\" channel $chan");
return $essid;
}
#############################################################
#
# $boolean= &isdown ();
# $boolean= &isup ();
#
# Return true if the interface is down or up.
sub isdown { return ($ap =~ /^Not-Assoc/) || ($gw eq "") ||
($missed_pings >= $PING_THRESH); }
sub isup { return ($gw ne "") && ($missed_pings < $PING_THRESH); }
#############################################################
#
# &iwclear("eth0");
#
# Clear wireless settings.
sub iwclear {
`$iwconfig $wifi ap any essid "" channel 0 2>/dev/null`;
$ip= $essid= "";
$chan= 0;
$Q= 0;
}
#############################################################
#
# $Q= &wifiQ();
#
# Get current signal quality. This comes from /proc.
sub wifiQ {
my @Y= `cat /proc/net/wireless`;
my ($s, $n); # signal, noise
foreach (@Y) {
chomp;
s/^\s+//; # chomp leading space
next if not /^$wifi:/; # only ours
my @L= split (/\s+/); # split into words,
my ($q)= $L[2] =~ /(\d+)/; # get quality
return $q;
}
return 0;
}
#############################################################
#
# ($quality, $essidstring, $channelnumber, $apMACaddress, $assocyesno)=
# getwifi();
#
#
# Extracts current-connection information from the wifi adapter.
#
# Surprisingly, I get either : or = for the keyword:data
# separator; driver dependent?
#
# EXAMPLE unassociated:
#
# eth1 unassociated ESSID:off/any Nickname:"unit"
# Mode:Managed Frequency=nan kHz Access Point: Not-Associated
# Bit Rate:54 Mb/s Tx-Power:16 dBm
# Retry limit:15 RTS thr:off Fragment thr:off
# Power Management:off
# Link Quality:0 Signal level:0 Noise level:0
# Rx invalid nwid:0 Rx invalid crypt:0 Rx invalid frag:0
# Tx excessive retries:0 Invalid misc:108763 Missed beacon:0
#
# EXAMPLE associated:
#
# eth1 IEEE 802.11g ESSID:"UCInet Mobile Access" Nickname:"unit"
# Mode:Managed Frequency:2.412 GHz Access Point: 00:0E:38:3F:13:B0
# Bit Rate:11 Mb/s Tx-Power:15 dBm
# Retry limit:15 RTS thr:off Fragment thr:off
# Power Management:off
# Link Quality=48/100 Signal level=-79 dBm Noise level=-81 dBm
# Rx invalid nwid:0 Rx invalid crypt:0 Rx invalid frag:0
# Tx excessive retries:0 Invalid misc:109077 Missed beacon:0
#
# The rt2570 driver returns iwconfig data differently than
# others; the "Access Point: ..." item simply disappears,
# rather than state "Not-associated" as others do. It also displays
# the name of the driver ("RT2500USB WLAN") instead of protocol
# ("IEEE 802.11g") or when unassociated, "not-associated".
#
# Bit rate always says 2Mb.
#
# EXAMPLE not associated:
#
# rausb0 ESSID:"2350 Allesandro" Nickname:"hornet"
# Mode:Managed Frequency=2.417 GHz
# Bit Rate=2 Mb/s
# RTS thr:off Fragment thr:off
# Link Quality=0/100 Signal level:-79 dBm Noise level:-202 dBm
# Rx invalid nwid:0 Rx invalid crypt:0 Rx invalid frag:0
# Tx excessive retries:0 Invalid misc:0 Missed beacon:0
# EXAMPLE associated:
#
# rausb0 RT2500USB WLAN ESSID:"2350 Allesandro" Nickname:"hornet"
# Mode:Managed Frequency=2.417 GHz Access Point: 00:11:50:72:57:D2
# Bit Rate=2 Mb/s
# RTS thr:off Fragment thr:off
# Link Quality=61/100 Signal level:-79 dBm Noise level:-202 dBm
# Rx invalid nwid:0 Rx invalid crypt:0 Rx invalid frag:0
# Tx excessive retries:0 Invalid misc:0 Missed beacon:0
sub getwifi {
my @Y= `$iwconfig $wifi 2>/dev/null`;
my $essid= "";
my $wep= "";
my $chan= 0;
my $ap= "";
my $Q= 0;
my $assoc= 0; # assume not
foreach (@Y) {
chomp;
s/^\s+//;
# The presence of either of these means NOT ASSOCIATED.
$assoc= 0 if /^$wifi\s+unassociated/i; # not rt2570
$assoc= 0 if /Access Point.\s+not.associated/i; # not rt2570
# ($essid)= /ESSID."(.*)"\s+Nic/ if /ESSID/;
($essid)= /ESSID."(.*?)"/ if /ESSID/; # non-greedy
($chan)= /Frequency.([\.\d]+) GHz/ if /Frequency/;
($Q)= /Quality.(\d+)/ if /Quality/;
($ap)= /Access Point.\s*([-:0-9a-fA-F]+)/ if /Access Point/;
($wep)= /Encryption key.\s*(\w+)/ if /Encryption key/;
}
# Clean up the result.
$ap= "" if not $ap; # (parse error)
$ap= lc $ap; # a - f not A - F
$assoc= 0 if not $ap;
$assoc= 0 if $ap eq "00:00:00:00:00:00"; # man iwconfig
$assoc= 1 if $ap =~ /[-:0-9a-fA-F]+/; # contains MAC
$essid= "" if not $essid; # when ESSID:off/any
$chan= "0" if not $chan; # see freq->chan table
$chan= $CHANNELS{$chan}; # freq to chan
return ($Q, $essid, $chan, $ap, $assoc);
}
#############################################################
#
# Scan for APs, add new ones to the database.
#
#rausb0 Scan completed :
# Cell 01 - Address: 00:0F:24:F1:7E:20
# Mode:Managed
# ESSID:"UCInet Mobile Access"
# Encryption key:off
# Channel:1
# Cell 02 - Address: 00:0E:38:3F:13:B0
# Mode:Managed
# ESSID:"UCInet Mobile Access"
# Encryption key:off
# Channel:1
#
# The fields come in any order; there may be others,
# and some may be missing (eg. Quality, rt2570).
sub iwscan {
my ($essid, $mac, $wep, $chan, $Q);
my @Y= `$iwlist $wifi scan`;
$mac= "";
$essid= $wep= "";
$chan= 0; #
$Q= 0; # doesn't always exist
foreach (@Y) {
s/^\s+//; # clip leading space,
if (/^Cell/) { # a new cell;
($mac)= /Address:\s*(.+)/; # start cell data
$essid= $wep= $chan= "";
next;
}
next if not $mac; # need a MAC to continue
# Since we don't know the order, we store the data every time. Dumb
# but simple.
($essid)= /^ESSID:"(.+)"/ if /^ESSID/;
($chan)= /^Channel:(.+)/ if /^Channel/;
($wep)= /^Encryption key:(.+)/ if /^Encryption key/;
($Q)= /^Quality=(\d+)/ if /^Quality/;
$mac= lc $mac;
$wep= $wep eq "on" ? "locked" : "open";
$APs{$mac}= "$essid~$chan~$wep~$Q";# it's our delim
}
# %APs is the list of visible APs. Add new ones to the database.
foreach $mac (keys %APs) {
next if &db_get ($mac); # ignore existing,
($essid, $chan, $wep, $Q)= split (/~/, $APs{$mac});
&log ("new AP $mac \"$essid\" $Q");
&db_param ("ap", $mac);
&db_param ("essid", $essid);
&db_param ("wep", $wep);
&db_param ("chan", $chan);
&db_param ("Q", $Q);
&db_param ("time", time);
&db_param ("success", 0);
&db_param ("fail", 0);
&db_param ("score", 0);
&db_insert();
}
}
#############################################################
#
# $string= getmyip();
#
# Return current interface IP address.
sub getmyip {
my @Y= `$ifconfig $wifi 2>/dev/null`;
$ip= "";
foreach (@Y) {
chomp;
my ($foo)= /inet addr:(.*?) /; #
$ip= $foo if defined $foo;
}
return $ip;
}
#############################################################
#
# $n= &getgw();
#
# Rather than look at a specific interface, we look for a default route;
# if there isn't one, then most probably the network is useless.
sub getgw {
my @Y= `$netstat`;
$gw= ""; # remember gateway here
foreach (@Y) {
chomp;
my @L= split (/\s+/); # split into words,
$gw= $L[1] if $L[0] eq "0.0.0.0"; # look for default
}
return $gw;
}
#############################################################
#
# $n= &pinger();
#
# Ping the gateway (if any). Tallies the number of missed pings
# in a row; any ping response clears the counter.
sub pinger {
return if $gw eq ""; # can't ping!
`$ping $gw 2>/dev/null`;
my $r= $? >> 8; # $r is return code
if ($? == -1) {
&log ("OOPS! Could not execute \"$ping $gw\"!");
$missed_pings= $PING_THRESH;
} elsif ($r == 0) { # if success,
$missed_pings= 0; # reset counter,
} elsif ($r == 1) { # lost ping(s)
++$missed_pings;
} else { # can't ping; lost route, etc
$missed_pings= $PING_THRESH;
&log ("pinger says $r ($?)");
}
}
sub min {
my $a= shift;
my $b= shift;
return ($a < $b ? $a : $b);
}
#############################################################
#
# @L= &listAPs();
#
# Returns an array of lines describing the visible APs,
# with the currently associated one marked.
#
sub listAPs {
my @L= ();
my $i= 0;
foreach my $ap (sort keys %APs) {
my ($essid, $chan, $wep, $Q)= split (/~/, $APs{$ap});
&db_get($ap);
my $score= &db_param("score");
push @L, "Visible: \"$essid\" $ap chan=$chan Q=$Q score=$score";
}
push @L, "AP: None" if scalar @L == 0;
return @L;
}
#############################################################
#
# &log(array of text lines);
#
sub log {
my @L= @_;
my $d= `date +"%d-%b-%Y.%H%M.%S"`; chomp $d;
open (F, ">>$logf"); # start logging,
foreach (@L) {
print F "$d $_\n"; # log it,
}
close F;
}
#############################################################
#
# &flagup();
#
# Write minimal connection info to the network-up flag file.
sub flagup {
open (F, ">$netflagfile") or return;
my $d= `date +"%d-%b-%Y.%H%M.%S"`; chomp $d;
# print F "$d $ip $gw \"$essid\"\n";
print F "$essid\n$ip\n$d\n";
close F;
}
#############################################################
#
# &display("message", "l1", "l2", ...);
#
# Display the current interface state preceded by a short
# message, followed by any other passed lines of text.
sub display {
my @L= @_;
return if ! $fg;
for (my $i= 0; $i < $LINES; ++$i) {
move ($i, 0);
addstr ($i, 0, shift @L) if scalar @L;
clrtoeol();
}
move ($LINES-1, $COLS-1);
refresh;
}
sub usage {
print << "HELP";
$0 -f -l file -i interface
-f run in foreground
-g ignore ignition state
-l file log into file (default $logf)
-i intf use interface intf (default $wifi)
HELP
exit;
}
#############################################################
#
# &dbopen("filename");
#
# Open (connect to) the database. CSV for now.
#
sub db_open {
my $f= shift;
return 1 if $db_o; # already open
$dbpath= ""; $dbfn= $f; # default path, name
($dbpath, $dbfn)= $f =~ '^(.*)/(.*)$' # split name if
if $f =~ /\//; # name contains path
&db_new() if not -e $dbfile; # create
&log ("db opens $dbfn"); # (unnecessary)
$dbh= DBI-> connect ("DBI:CSV:f_dir=$dbfn"); # do the open,
if (not $dbh) {
&log ("gak! can't open database $dbfn!");
return(0);
}
$dbh-> {RaiseError}= 0;
$db_dirty= 0;
$db_o= 1;
return $dbh;
}
#############################################################
#
# Close (disconnect) the database.
#
sub db_close {
return 1 if not $db_o; # not open
&db_put(); # write out changes
&log ("db closes");
$dbh-> disconnect ()
or &log ("db_disconnect says: " . $DBI::errstr);
$db_o= 0;
}
#############################################################
#
# db_get ($ap)
#
# Locate the record ap=($ap) and loads the first row into the
# cache (even if there are other rows). Returns 0 if not found.
# Croaks on error.
#
sub db_get {
my $ap= shift;
# &db_open($dbfile) if not $db_o; # open if necessary,
&db_put(); # write out changes first,
$sth= &db_sel ("ap=$ap"); # attempt the select,
return 0 if ! $sth; # nothing matches
return &db_nextrow; # return all the data.
}
#############################################################
#
# db_getv ("field=contents", "field=contents...")
#
# Locate the record containing all of the specified fields and
# loads the first row into the cache (even if there are other rows).
# Returns 0 if not found. Croaks on error.
#
sub db_getv {
# &db_open($dbfile) if not $db_o; # open if necessary,
&db_put(); # write out changes first,
$sth= &db_sel (@_); # attempt the select,
return 0 if ! $sth; # nothing matches
return &db_nextrow; # return all the data.
}
#############################################################
#
# db_nextrow
#
# Returns an array containing the next row of data
# from the most recent db_sel. sth better be valid!
# Returns 0 if no data found (usually because previous
# select failed).
#
sub db_nextrow {
my $u;
# &db_open($dbfile) if not $db_o; # open if necessary,
my @L= &db_param(); # make list of field names
my $i= 0; # name index and return code
# Fetchrow_* returns data as tainted. We can however
# most reasonably assume that the database is untainted.
foreach ($sth-> fetchrow_array()) { # fields in data,
($u)= $_ =~ /^(.*)$/; # untaint
$u= "" if $u eq $NIL; # convert empty strings back,
&db_param ($L[$i++], $u); # hash 'em
}
return $i;
}
#############################################################
#
# db_exists ("field=contents", "field=contents", ..)
#
# Return true if a record with all of the specified field contents
# exists. Doesn't modify the cache.
#
sub db_exists {
my @F= @_;
# &db_open($dbfile) if not $db_o; # open if necessary,
$sth= &db_sel (@F); # attempt the select,
return 0 if ! $sth; # nothing matches
my @L= $sth-> fetchrow_array();
return @L > 0;
}
#############################################################
#
# db_sel ("field=contents", "field=contents...")
#
# Locate record(s) with field contents indicated (AND of all
# patterns). Returns false if error/not found.
#
sub db_sel {
my ($f, $c, $w);
my @L;
my $l;
my $n;
# &db_open($dbfile) if not $db_o; # open if necessary,
&db_put(); # write out changes first,
@L= &db_param();
$l= join ' ', @L; # for error-checking
# Make select string:
# SELECT field,field,...field FROM $dbfn WHERE $field="contents"
my $prep=
"SELECT "
. join (',', @L)
. " FROM $dbfn"
. " WHERE ";
$n= 0;
foreach (@_) { # add criteria
($f, $c)= split '=', $_;
if (not $l =~ /\b$f\b/) { # field name must exist!
&log ("db_sel non-existent field /$f=$c/ with\n $l");
return 0;
}
$c= $dbh-> quote ($c) if $c ne "?";
$prep .= ' AND ' if $n++;
$prep .= "$f=$c";
}
if (not $sth= $dbh-> prepare ($prep)) {# prepare,
&log ("db_sel1: n=$n prep=$prep" . $dbh-> errstr);
return 0;
}
if (not $sth-> execute()) { # execute
&log ("db_sel2: n=$n prep=$prep" . $dbh-> errstr);
return 0;
}
if ($sth-> err) {
&log ("db_sel3: " . $sth-> err);
return 0;
}
return $sth;
}
#############################################################
#
# Write out the cached record to the database. Returns 0
# if error.
#
sub db_put {
my $ap;
my $fn;
return if ! $db_dirty; # nothing to do
# &db_open($dbfile) if not $db_o; # open if necessary,
$ap= &db_param ("ap"); # test this
return if not defined ($ap) or ($ap eq "");
my $prep= "UPDATE $dbfn SET "
. join (', ',
map { "$_=" . $dbh-> quote (&db_param_nil ($_)); } &db_param())
. " WHERE ap="
. $dbh-> quote ($ap);
if (not $sth= $dbh-> prepare ($prep)) {
&log ("ERROR: db_put3: using /$prep/\n is" . $dbh-> errstr);
return 0;
}
# This execute triggers a taint error:
#
# tinyReg: Execution ERROR: Insecure dependency in open while running with -T switch at /usr/local/lib/perl5/5.8.7/mach/IO/File.pm line 192.
# tinyReg: called from /home/www/tomj/cgi/dbase.pm at 296.
#
# yet nothing in it is tainted (ran everything through as regexp to test)
#
# ("line 296" is the db_put() in db_commit(); any db_put does it)
if (not $sth-> execute) {
&log ("ERROR: db_put4: using /$prep/\n is " . $dbh-> errstr);
$db_dirty= 0; # no sense trying further.
return 0;
}
$db_dirty= 0; # has been written.
return 1;
}
#############################################################
#
# Insert a new record into the database. Returns 0 if error.
#
sub db_insert {
# &db_open($dbfile) if not $db_o; # open if necessary,
&db_put(); # write out changes first,
my $prep=
"INSERT INTO $dbfn ("
. join (', ', &db_param())
. ") values ("
. join (', ', map { $dbh-> quote (&db_param_nil ($_)) } &db_param())
. ")";
if (not $sth= $dbh-> prepare ($prep)) {
&log ("db_insert1: using /$prep/:\n\n" . $dbh-> errstr);
return 0;
}
if (not $sth-> execute) {
&log ("db_insert2: using /$prep/:
\n\n" . $dbh-> errstr);
return 0;
}
$db_dirty= 1;
return 1;
}
#############################################################
#
# Rollback changes to the database.
#
sub db_rollback {
return if $dbh-> {AutoCommit}; # won't work if true
if (not $dbh-> rollback()) {
&log ("db_rollback says: " . $DBI::errstr);
}
}
#############################################################
#
# Commit changes to the database.
#
sub db_commit {
&db_put(); # write out changes first,
return if $dbh-> {AutoCommit}; # no point if true
if (not $dbh-> commit()) {
&log ("db_commit says: " . $DBI::errstr);
}
}
#############################################################
#
# db_param(name, value);
#
# Basic access to db_cache contents:
# 1. set {name}= value if value defined;
# 2. return current value of {name}, if defined;
# 3. else return a list of keys, if no parameters given
# We set the dirty bit if the cache is modified and needs
# flushing.
#
sub db_param {
my $n= shift; # name of parameter,
my $v= shift; # optional value,
my @L;
my ($format, $name, $foo);
# Set param $n to $v.
if (defined $v) {
$db_cache {$n}= $v; # write datum,
$db_dirty= 1; # needs flushing
}
# Return param $n.
if (defined $n) { # return a field,
return $db_cache {$n}; # get contents,
}
# No args, return list of fieldnames.
return (split /\s+/, $FIELDORDER);
}
############################################################
#
# &db_param_nil (name);
#
# Same as &db_parm(name), above, except "" return values are
# changed to $NIL.
#
sub db_param_nil {
my $n= shift; # name of parameter,
my $v= &db_param ($n); # get value,
$v= $NIL if $v eq "";
return $v;
}
############################################################
#
# &db_param_size (fieldname)
#
# Returns fieldsize for the given field name or undef if
# it doesn't exist.
sub db_param_info {
my $field= shift; # DB field name
return $DBRECD {$field};
}
############################################################
#
# Create a new, empty database.
sub db_new {
my $fn= shift;
my $sth;
my @L;
my %INIT = (
"ap" => "00:11:50:72:57:d2",
"essid" => "2350 Allesandro",
"chan" => 2,
"wep" => "open",
"Q" => 3,
"time" => 0, # time stamp last access
"success" => 1, # associate successes
"fail" => 0, # associate failures
"score" => 1 # total score (for offline comparison)
);
# Create new, empty database.
&log ("New database $dbfile");
unlink "$dbfile"; # delete any old one,
if (not $dbh= DBI-> connect ("DBI:CSV:f_dir=$dbpath")) {
&log ("Cannot connect: " . $DBI::errstr);
return 0;
}
# Build CREATE command string, prepare and execute it.
# "CREATE TABLE filename (foo char(32), bar (char16), ...)";
foreach (&db_param()) { # make ordered list
my $s= &db_param_info ($_); # fieldnames
push @L, "$_ char($s)"; # and sizes
}
my $prep= "CREATE TABLE $dbfn (" . join (", ", @L) . ")";
if (not $sth= $dbh-> prepare ($prep)) { # prepare and
&log ("Cannot prepare: " . $dbh-> errstr);
return 0;
}
if (not $sth-> execute()) {
&log ("Cannot execute: " . $dbh-> errstr);
return 0;
}
# Now build a command to insert the initial record, prepare and execute.
# "INSERT INTO filename (id,state,domain) VALUES ('2','0','bar.com')"
# Set unspecified fields to NIL; the DB code doesn't like empty strings.
@L= ();
foreach (&db_param()) { # field contents list
my $c= $INIT{$_}; # empty/undef
$c= $NIL if not defined $c; # fields not
$c= $NIL if $c eq ""; # tolerated.
push @L, $dbh-> quote ($c);
}
my $l= "INSERT INTO $dbfn (" .
join (',', &db_param()) . # field name list
") VALUES (" .
join (',', @L) . # field contents list
")";
if (not $sth= $dbh-> prepare ($l)) {
&log ("db_put1: l=\"$l\" errstr=" . $dbh-> errstr);
return 0;
}
if (not $sth-> execute()) {
&log ("db_put2: l=\"$l\" errstr=" . $dbh-> errstr);
return 0;
}
# Wrap it up.
#$dbh-> commit;
if (not $dbh-> disconnect) {
&log ("$dbh-> errstr");
return 0;
}
return 1;
}