# ialive - Program to test whether the Internet is up and active.
# Rick Smereka, Copyright (C) 2006.

# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.

# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.

# You should have received a copy of the GNU General Public License
# along with this program; if not, get a copy via the Internet at
# http://gnu.org/copyleft/gpl.html or write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston,
# MA 02111-1307 USA

# You can contact the author via email at rsmereka@future-lab.com

# Program syntax:

#    ialive -c nn -b -q -p ping_dest -l log_file

# Where:

# 'c' is the number of pings to send ('nn')
# 'b' record stats in 'bbuuzzb' table (see below)
# 'q' run quietly
# 'p' host name or IP address to ping
# 'l' log name or destination

# This program works by pinging a specific host (default host is used if
# no host if specified using the 'p' switch. The results can be output to
# the screen, to a log file, and/or to a database table using the 'bbuuzzb'
# database. You may output to any combination of these three destinations.
# Output to the 'bbuuzzb' database uses the table name listed in the global
# constants. The data is stored where a single day is contained within a record.
# The field layout is as follows:
#
# field subfield subsubfield description
#
#   1                        date (julian number)
#   2       *         1      time (24hr, no colon)
#   2       *         2      number of pings sent
#   2       *         3      number of pings successfully received

# Since there is no support for 'exec' under MacOS, this program will
# not run under MacOS.

# Initial Tcl version, Jun/2006, Rick Smereka

# Modified to record and assume nothing received if the 'ping'
# command returns with no output. Aug/2006, Rick Smereka

# Changed format of field one in 'bbuuzzb' record from a date represented
# by a julian number to the date in 'yyyymmdd' form. Sep/2006,
# Rick Smereka

# required path to library modules
set TCLDIR /home/rick/gpl/tcl

source $TCLDIR/lib/stdhead.tcl
source $TCLDIR/lib/comcode.tcl
source $TCLDIR/lib/appinit.tcl
const MULTIUSER 0
source $TCLDIR/dbeng/dbmess.tcl
source $TCLDIR/dbeng/dbiocode.tcl
source $TCLDIR/dbeng/dbeng.tcl
source $TCLDIR/dbeng/dbengcfg.tcl
source $TCLDIR/dbeng/dbengcat.tcl
source $TCLDIR/dbeng/dbengsrt.tcl

# program constants
const APNAME "ialive"
const VERSION "1.21-2006.09.06"
const DEFAULT_HOST "www.yahoo.com"
const BBUUZZB_TABLE "ialive"

# database constants
const FIELD_DATE 1
const FIELD_PING_DATA 2
const SUBSUBFIELD_TIME 1
const SUBSUBFIELD_PINGS_SENT 2
const SUBSUBFIELD_PINGS_RECV 3

# database tid
set tid 0

# global variables
set log_dest ""
set ping_dest $DEFAULT_HOST
set ping_count 4
set is_quiet 0
set use_bbuuzzb 0

proc process {} {
   # Execute the 'ping' command, parse the output to determine the 
   # response and possibly record the response in the 'bbuuzzb' table.
   global ping_count ping_dest ping_deadline tcl_platform use_bbuuzzb tid
   global FIELD_DATE DBENG_OK DBENG_EOF FIELD_PING_DATA SUBSUBFIELD_TIME
   global SUBSUBFIELD_PINGS_SENT SUBSUBFIELD_PINGS_RECV
   set mname "process"
   set expc [auto_execok "ping"]
   set command exec
   set ret ""

   if {$tcl_platform(platform) == "unix"} {
      set ret "$expc -c $ping_count $ping_dest"
   }

   if {$tcl_platform(platform) == "windows"} {
      set ret "$expc -n $ping_count $ping_dest"
   }

   if {$ret == ""} {
      app_out "$mname:this program will only run under Linux/Unix/BSD\
               or Windows"
      exit
   }

   set status [catch_exec $ret msg]
   app_out "$mname:[get_ftime]:comline=$ret,status=$status,msg=$msg"
   set line [find_stats $msg]

   if {$line == ""} {
      # if there is no output from 'ping' command, assume process gave up
      app_out "$mname:output 'ping' line is empty,assuming nothing received"
     
      # mock-up output line
      set line "status=$status:msg=[lindex $msg 0]:sent $ping_count,recv 0" 
   }

   app_out "$mname:line=$line"

   if {!$use_bbuuzzb} {
      return
   }

   # store sent and received stats in daily record
   # first field is the current date ('yyyymmdd')
   set curdatime [get_time]
   set curdate [string range $curdatime 0 7]
   set curtime [string range $curdatime 8 11]

   # attempt to locate existing record, if not present, create new record
   set ret [db_find_field $tid 0 $curdate $FIELD_DATE]

   if {$ret != $DBENG_OK} {
      if {$ret == $DBENG_EOF} {
         app_out "$mname:daily record does not exist,creating it"
         set ret [db_new $tid]

         if {$ret != $DBENG_OK} {
            app_out "$mname:bad rc([db_io_code_string $ret]) from db_new"
            return
         }

         set ret [db_put_field $tid $FIELD_DATE $curdate]

         if {$ret != $DBENG_OK} {
            app_out "$mname:bad rc([db_io_code_string $ret]) from\
                     db_put_field"
            return
         }
         
         set subfield 1
      } else {
         app_out "$mname:bad rc([db_io_code_string $ret]) from db_find_field"
         return
      }
   } else {
      set ret [db_get_nsubfields $tid $FIELD_PING_DATA tmp]

      if {$ret != $DBENG_OK} {
         app_out "$mname:bad rc([db_io_code_string $ret]) from\
                  db_get_nsubfields"
         return
      }

      set subfield [expr $tmp + 1]
   }

   # new subfield is added onto the end of the list
   set ret [db_put_subsubfield $tid $FIELD_PING_DATA $subfield \
                               $SUBSUBFIELD_TIME $curtime]

   if {$ret != $DBENG_OK} {
      app_out "$mname:bad rc([db_io_code_string $ret]) from\
               db_put_subsubfield(time)"
      return
   }

   # extract sent and received stats from ping output
   # method chosen works on all platforms by grabing
   # the first number in the first two (comma delimited) words on the line
   if {![get_sent_recv $line 1 pings_sent]} {
      return
   }

   if {![get_sent_recv $line 2 pings_recv]} {
      return
   }
   
   # put the rest of the table data and write
   set ret [db_put_subsubfield $tid $FIELD_PING_DATA $subfield \
                               $SUBSUBFIELD_PINGS_SENT $pings_sent]

   if {$ret != $DBENG_OK} {
      app_out "$mname:bad rc([db_io_code_string $ret]) from\
               db_put_subsubfield(pings_sent)"
      return
   }

   set ret [db_put_subsubfield $tid $FIELD_PING_DATA $subfield \
                               $SUBSUBFIELD_PINGS_RECV $pings_recv]

   if {$ret != $DBENG_OK} {
      app_out "$mname:bad rc([db_io_code_string $ret]) from\
               db_put_subsubfield(pings_recv)"
      return
   }

   db_write $tid
   app_out "$mname:curdate=$curdate,curtime=$curtime,subfield=$subfield"
   app_out "$mname:pings_sent=$pings_sent,pings_recv=$pings_recv"
}

proc find_stats {msg} {
   # Locate the line containing the stats. Returns the line containing
   # the send and receive stats upon success, an empty
   # string otherwise.
   set mname "find_stats"
   set nlines [llength $msg]

   if {$nlines == 0} {
      app_out "$mname:no output from command"
      return ""
   }

   for {set i 0} {$i < $nlines} {incr i} {
      set line [lindex $msg $i]

      # look for the first line with more than one comma delimited field
      if {[ll_words $line ","] > 1} {
         return [trim $line]
      }
   }

   # we should never get here, just in case
   app_out "$mname:stats line in ping output not found"
   return ""
}

proc parse_comm_line {gc gv} {
   # Parse entire command line. Returns 1 upon success, 0 otherwise.
   global APNAME SWITCH_CHAR ping_count use_bbuuzzb is_quiet ping_dest
   global log_dest
   set curparm 0

   while {$curparm < $gc} {
      set parm [lindex $gv $curparm]

       if {[string index $parm 0] == $SWITCH_CHAR} {
          set sw [string toupper [string index $parm 1]]

          switch $sw {
             C {
                incr curparm

                if {$curparm >= $gc} {
                   puts "missing count in 'C' parameter"
                   return 0
                }

                set val [lindex $gv $curparm]

                if {![num $val]} {
                   puts "non numeric value on 'C' parameter"
                   return 0
                }

                if {$val <= 0} {
                   puts "out of range ping count,s/b >0"
                   return 0
                }
     
                set ping_count $val
                incr curparm
             }

             B {
                set use_bbuuzzb 1
                incr curparm
             }

             Q {
                set is_quiet 1
                incr curparm
             }

             P {
                incr curparm

                if {$curparm >= $gc} {
                   puts "missing ping destination in 'P' parameter"
                   return 0
                }

                set ping_dest [lindex $gv $curparm]
                incr curparm
             }

             L {
                incr curparm

                if {$curparm >= $gc} {
                   puts "missing log name/destination in 'L' parameter"
                   return 0
                }

                set log_dest [lindex $gv $curparm]
                incr curparm
             }

             default {
                puts "unknown parameter '$parm'"
                return 0
             }
          }
      } else {
         puts "unknown parameter '$parm'"
         return 0
      }

   }

   return 1
}

proc c_initialize {} {
   # Start the 'dbeng' local engine, read the config file and
   # display the result settings. Returns 1 upon success, 0
   # otherwise.
   global DBENG_OK DBENG_CONFIG_UNABLE_TO_OPEN BBUUZZB_TABLE tid
   set mname "c_initialize"

   set ret [db_initialize]

   # interpret code from init which may be a
   # fatal config error
   switch $ret \
      $DBENG_OK {app_out "$mname:read config file successfully"} \
      $DBENG_CONFIG_UNABLE_TO_OPEN \
                {app_out "$mname:config file not found,loaded defaults"} \
      default {app_out "$mname:fatal config error([db_io_code_string $ret])"; \
               app_out "$mname:terminating";return 0}

   db_config_get_tmp_path mes
   app_out "$mname:tmp path is '$mes'"
   db_config_get_log mes
   app_out "$mname:log is '$mes'"
   set ret [db_config_get_catalog mes]

   if {$ret == $DBENG_OK} {
      app_out "$mname:catalog is '$mes'"
   } else {
      app_out "$mname:catalog name not loaded"
   }

   db_config_get_catalog_flag flag

   if {[flag_2_logic_string $flag mes]} {
      app_out "$mname:catalog is $mes"
   }

   # attempt to open output table
   set ret [db_open $BBUUZZB_TABLE tid]

   if {$ret != $DBENG_OK} {
      app_out "$mname:unable to open table '$BBUUZZB_TABLE',\
               rc=[db_io_code_string $ret]"
      return 0
   }

   return 1
}

proc get_sent_recv {line which result} {
   # Get the sent or received stats from the ping data.
   # Returns 1 upon success, 0 otherwise.
   upvar $result uresult
   set mname "get_sent_recv"
   set uresult 0

   if {![ll_word $line parm $which ","]} {
      app_out "$mname:bad rc(0) from ll_word(line($which))"
      return 0
   }

   set nwords [words $parm]

   for {set i 1} {$i <= $nwords} {incr i} {
      if {![word $parm wrd $i]} {
         app_out "$mname:bad rc(0) from word($i)"
         return 0
      }

      if {[num $wrd]} {
         set uresult $wrd
         return 1
      }
   }

   app_out "$mname:bad rc(0) from get_sent_recv,count not found"
   return 0
}

proc app_out {mes} {
   # Output a message to enabled destination.
   global is_quiet

   if {[logman_is_active]} {
      logman $mes
      return
   }

   if {!$is_quiet} {
      puts $mes
   }
}

proc term_app {} {
   # Prepare to terminate the application. Shutdown all IPC API's.
   global use_bbuuzzb tid

   if {$use_bbuuzzb} {
      db_close $tid
      db_end
   }

   if {[logman_is_active]} {
      logman_end
   }

   appinit_remove_name
}

# Program main line.
# unbuffered stdout
fconfigure stdout -buffering none

# parse switches
if {![parse_comm_line $argc $argv]} {
   puts "program abort"
   exit
}

if {$log_dest != ""} {
   if {[logman_start $log_dest $APNAME]} {
      puts "unable to start log manager,program abort"
      exit
   }

   if {$is_quiet} {
      logman_console 0
   } else {
      logman_console 1
   }
}

# display logo
app_out "$APNAME for $tcl_platform(platform) Version $VERSION"
app_out "by Rick Smereka, Copyright (c) 2006"
app_out "$APNAME comes with ABSOLUTELY NO WARRANTY"
app_out "This is free software, and you are welcome to redistribute it"
app_out "under certain conditions; see 'gpl.txt' for information."

# register application name with 'appinit'
if {![appinit_register_name $APNAME]} {
   app_out "$APNAME:fatal error registering app name with appinit"
   exit
}

# initialize local engine if we are running locally or
# startup the 'socloc' interface (TCP only) and connect to a
# Bbuuzzb database server if we are running in
# client/server mode, only active if we are using
# the 'bbuuzzb' database
if {$use_bbuuzzb} {
   if {![c_initialize]} {
      exit
   }
}

if {[logman_is_active]} {
   app_out "$APNAME:logging is on"
   app_out "$APNAME:log name/destination is '$log_dest'"
} else {
   app_out "$APNAME:logging is off"
}

app_out "$APNAME:ping destination is '$ping_dest'"
app_out "$APNAME:ping count is $ping_count"
set ret [flag_2_logic_string $is_quiet logic_string]

if {$ret} {
   app_out "$APNAME:quiet mode is $logic_string"
}

set ret [flag_2_logic_string $use_bbuuzzb logic_string]

if {$ret} {
   app_out "$APNAME:Bbuuzzb database mode is $logic_string"
}

if {$use_bbuuzzb} {
   app_out "$APNAME:output bbuuzzb table is '$BBUUZZB_TABLE'"
}

process
term_app
exit
