aix-pm-cvs Mailing List for AIX Perl Modules (Page 3)

Status: Alpha

Brought to you by: gonter

aix-pm-cvs — CVS commit messages

You can subscribe to this list here.

2006	Jan	Feb	Mar	Apr	May	Jun	Jul	Aug	Sep	Oct	Nov	Dec (1)
2007	Jan	Feb (20)	Mar (14)	Apr (2)	May (15)	Jun (22)	Jul (11)	Aug (31)	Sep (11)	Oct (19)	Nov (15)	Dec
2008	Jan	Feb (4)	Mar	Apr (2)	May (6)	Jun (2)	Jul (4)	Aug (3)	Sep (10)	Oct (14)	Nov (7)	Dec (12)
2009	Jan	Feb (5)	Mar (8)	Apr (41)	May (8)	Jun (6)	Jul (3)	Aug (6)	Sep (6)	Oct (4)	Nov (7)	Dec
2010	Jan (2)	Feb (9)	Mar (7)	Apr (15)	May	Jun (5)	Jul (9)	Aug (2)	Sep (1)	Oct (17)	Nov	Dec
2011	Jan	Feb	Mar (6)	Apr (1)	May (7)	Jun (7)	Jul	Aug (1)	Sep (3)	Oct	Nov (1)	Dec (5)
2012	Jan (17)	Feb (7)	Mar (8)	Apr (11)	May (8)	Jun (2)	Jul (1)	Aug (5)	Sep (2)	Oct (1)	Nov (1)	Dec
2013	Jan (3)	Feb	Mar (1)	Apr (1)	May (1)	Jun	Jul (4)	Aug	Sep (5)	Oct (3)	Nov (2)	Dec (4)
2014	Jan (6)	Feb	Mar (1)	Apr	May (1)	Jun (4)	Jul (2)	Aug (5)	Sep (3)	Oct	Nov (2)	Dec (7)
2015	Jan	Feb	Mar	Apr	May	Jun	Jul (1)	Aug	Sep (5)	Oct (4)	Nov (3)	Dec (1)
2016	Jan (2)	Feb (1)	Mar	Apr (1)	May (2)	Jun (2)	Jul (5)	Aug (5)	Sep (4)	Oct (2)	Nov (1)	Dec (1)
2017	Jan (2)	Feb (1)	Mar (1)	Apr	May	Jun	Jul	Aug (6)	Sep	Oct (3)	Nov (4)	Dec

Flat | Threaded

<< < 1 2 3 4 5 .. 24 > >> (Page 3 of 24)

[aix-pm-cvs] hacks/misc fillup.pl,1.3,1.4

From: Gerhard G. <go...@us...> - 2015-10-20 09:21:44

Update of /cvsroot/aix-pm/hacks/misc
In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv24246

Modified Files:
	fillup.pl 
Log Message:
* Standard file size is now 4 MiB (that is, 4 blocks a 1 MiB)
* option --mem to copy fillup reference file into memory before writeing



Index: fillup.pl
===================================================================
RCS file: /cvsroot/aix-pm/hacks/misc/fillup.pl,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** fillup.pl	8 Jul 2014 16:47:14 -0000	1.3
--- fillup.pl	20 Oct 2015 09:21:42 -0000	1.4
***************
*** 16,19 ****
--- 16,20 ----
    -o <target-directory>
    -c <count> ... only copy that many times
+   --mb <count> ... generate random file; number of MiB; (1048576 * $count bytes)
    --dryrun ... only show what would be done
    --doit   ... perform the copy
***************
*** 41,44 ****
--- 42,48 ----
  my $dryrun= 1;
  my $cnt= -1;
+ my $block_size= 1048576;
+ my $mb_count= 4;
+ my $in_mem= 0;
  
  my @PAR= ();
***************
*** 53,57 ****
      elsif ($opt eq 'doit')  { $dryrun= 0; }
      elsif ($opt eq 'dryrun' || $opt eq 'dry-run') { $dryrun= 1; }
!     elsif ($opt eq 'output') { $output= $val; }
      else { usage(); }
    }
--- 57,64 ----
      elsif ($opt eq 'doit')  { $dryrun= 0; }
      elsif ($opt eq 'dryrun' || $opt eq 'dry-run') { $dryrun= 1; }
!     elsif ($opt eq 'output') { $output= $val || shift (@ARGV); }
!     elsif ($opt eq 'bs') { $block_size= $val || shift (@ARGV); }
!     elsif ($opt eq 'mb') { $mb_count= $val || shift (@ARGV); }
!     elsif ($opt eq 'mem') { $in_mem= 1; }
      else { usage(); }
    }
***************
*** 77,85 ****
  }
  
! unless (-f $input)
! {
!   my $cmd= "dd if=/dev/urandom of=$input bs=1048576 count=1";
!   print ">>> $cmd\n";
!   system ($cmd);
  }
  
--- 84,94 ----
  }
  
! my $file_size= $block_size*$mb_count;
! print "file_size=[$file_size]\n";
! if (!-f $input || (stat(_))[7] < $file_size)
! { # create input file if it does not exist or is too small
!   my @cmd= ('dd', 'if=/dev/urandom', "of=$input", "bs=$block_size", "count=$mb_count");
!   print ">>> ", join (' ', @cmd), "\n";
!   system (@cmd);
  }
  
***************
*** 89,92 ****
--- 98,111 ----
  }
  
+ my $buffer;
+ if ($in_mem)
+ {
+   unless (open (FI, '<:raw', $input))
+   {
+     die "can not read input file '$input'";
+   }
+   sysread (FI, $buffer, $file_size);
+ }
+ 
  my $i= 0;
  while (1)
***************
*** 122,134 ****
    else
    {
!     my $rc= system (@c);
!     print join (' ', @c), ", rc='$rc'\n";
!     if ($rc)
      {
!       print "copy return code=[$rc]; stopping\n";
!       last;
      }
    }
- 
  }
  
--- 141,172 ----
    else
    {
!     if ($in_mem)
      {
!       if (open (FO, '>:raw', $dest))
!       {
!         my $wr_size= syswrite (FO, $buffer, $file_size);
!         if ($wr_size != $file_size)
!         {
!           print "write_size ($wr_size) does not match file_size ($file_size)\n";
!           last;
!         }
!       }
!       else
!       {
!         print "can not open to $dest; exiting\n";
!         last;
!       }
!     }
!     else
!     {
!       my $rc= system (@c);
!       print join (' ', @c), ", rc='$rc'\n";
!       if ($rc)
!       {
!         print "copy return code=[$rc]; stopping\n";
!         last;
!       }
      }
    }
  }

[aix-pm-cvs] modules/util csv.pl,1.39,1.40

From: Gerhard G. <go...@us...> - 2015-09-28 16:22:18

Update of /cvsroot/aix-pm/modules/util
In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv7891/modules/util

Modified Files:
	csv.pl 
Log Message:
more convenient options

Index: csv.pl
===================================================================
RCS file: /cvsroot/aix-pm/modules/util/csv.pl,v
retrieving revision 1.39
retrieving revision 1.40
diff -C2 -d -r1.39 -r1.40
*** csv.pl	30 Dec 2014 09:43:27 -0000	1.39
--- csv.pl	28 Sep 2015 16:22:15 -0000	1.40
***************
*** 113,118 ****
      elsif ($opt eq 'sort')   { push (@sort_columns, split (',', $val || shift (@ARGV))); }
      elsif ($opt eq 'num')    { $sort_numeric= 1; }
!     elsif ($opt eq 'TAB')    { $CSV_SEP= "\t"; }
!     elsif ($opt eq 'UTF8')   { set_utf8(); }
      elsif ($opt eq 'border' || $opt eq 'style') { Util::Matrix::set_border_style ($val); }
      else { usage(); }
--- 113,119 ----
      elsif ($opt eq 'sort')   { push (@sort_columns, split (',', $val || shift (@ARGV))); }
      elsif ($opt eq 'num')    { $sort_numeric= 1; }
!     elsif ($opt eq 'nsort')  { push (@sort_columns, split (',', $val || shift (@ARGV))); $sort_numeric= 1; }
!     elsif ($opt eq 'TAB'    || $opt eq 'tab')   { $CSV_SEP= "\t"; }
!     elsif ($opt eq 'UTF8'   || $opt eq 'utf8')  { set_utf8(); }
      elsif ($opt eq 'border' || $opt eq 'style') { Util::Matrix::set_border_style ($val); }
      else { usage(); }

[aix-pm-cvs] modules/util/Util/Mail Processor.pm,NONE,1.1

From: Gerhard G. <go...@us...> - 2015-09-08 16:11:43

Update of /cvsroot/aix-pm/modules/util/Util/Mail
In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv5433/modules/util/Util/Mail

Added Files:
	Processor.pm 
Log Message:
ancient mail processor undigged

--- NEW FILE: Processor.pm ---

use strict;

package Util::Mail::Processor;

my $verbose= 0;

# ----------------------------------------------------------------------
# these hosts are considered local when analyzing received lines
my %IP_HOP_OK=
(
  '127.0.0.1' => 'localhost',
);

my $mon= 0;
my %MON= map { $_ => $mon++ } qw(jan feb mar apr may jun jul aug sep oct nov dec);

# ----------------------------------------------------------------------
my %IMAGE_EXT= map { $_ => 1 } qw(jpg jpeg pjpeg gif tif tiff bmp NONE);
my %AUDIO_EXT= map { $_ => 1 } qw(mp3);
my %VIDEO_EXT= map { $_ => 1 } qw(mpeg mpg avi);

# ----------------------------------------------------------------------
my %ANTIVIR_FNM= map { $_ => 1 }
qw(antivir.vdf ave32.exe avfile.hlp avgctrl.exe avgctrl.hlp avguard.log
   avrep32.exe avrep32.gid avrep32.hlp avrep32.ini avsched32.dat
   avsched32.exe avsched32.gid avsched32.hlp avsched32.ini avwin.act
   avwin.log avwin95.exe avwin95.fts avwin95.gid avwin95.hlp avwin95.ini
   avwin9xp.exe display.spw display.win faqpe_de.htm ftpdlvdf.$$$
   hbedv.key inetupd.alg inetupd.exe inetupd.ini inetupd.log liesmich.wri
   lizenz.wri savedvdf.$$$ service.ini suppcoll.exe uninst.isu uninst.txt
   virinfo.gid virinfo.hlp
  );

my %VIRUSES= map { $_ => 1 }
qw(CFGWIZ32.EXE ARP.EXE IDLE31.EXE IDLE32.EXE DISCOVER.EXE SYSOCMGR.EXE
   DPLAYSVR.EXE SUCATREG.EXE MAKECFG.EXE MSOOBE.EXE SULFNBJ.EXE AOLTRAY.EXE
   DPLAYSVQ.EXE TASKMAN.EXE RG2CATDB.EXE ADDREG.EXE DLLHOST.EXE LGPHACLG.EXE
   SULFNBK.EXE DELPRT32.EXE START.EXE OEMRUN.EXE OCTKSTAT.EXE CCJDPHCC.EXE
   CMMON32.EXE ACTMOVIE.EXE DSSSIG.EXE
   CB31.EXE WTC.EXE NUMBER.COM
   SPALTE.EXE CONTROLFIDS.PIF AUTOMATION.BAT INFORMATIONEN.BAT UNTERNEHMEN.EXE
   VORGESCHLAGEN.COM HYPERLINK.BAT KARIN.COM LAUNCHER.COM IHRER.COM
   Q216309.EXE
  );
my %BADTRANS_part1= map { $_ => 1 }
qw(PICS IMAGES README NEW_NAPSTER_SITE NEWS_DOC HAMSTER YOU_ARE_FAT!
   SEARCHURL SETUP CARD ME_NUDE SORRY_ABOUT_YESTERDAY S3MSONG DOCS HUMOR
   FUN
);
my %BADTRANS_part2= map { $_ => 1 } qw(doc mp3 zip);
my %BADTRANS_part3= map { $_ => 1 } qw(pif scr);

# ----------------------------------------------------------------------
sub new
{
  my $class= shift;
  my $HDR=
  {
    'seq' => [],
    'name' => {},
    'parts' => [],    # list of MIME parts; these are again headers
  };
  bless $HDR;
}

# ----------------------------------------------------------------------
# analyze regular mail hader as found in any mbox format mail file
sub analyze_header
{
  my $class= shift;
  my $mail= shift;   # array of mail lines

  my $HDR= &new ();
  # print "analyze_header: class=$class mail='$mail' HDR='$HDR'\n";

  map {$HDR->{$_}= undef} qw(sender);
  $HDR->{recipients}= [];

  my $hdr_obj= undef;
  my $l;
  my $in_hdr= 1;
  my @body;
  foreach $l (@$mail)
  {
    $l=~ s/[\r\n]//g;

    unless ($in_hdr)
    {
      push (@body, $l);
      next;
    }

    if ($l =~ /^\s*$/)
    {
      $in_hdr= 0;
      $HDR->{'body'}= \@body;
      next;
    }

    # print "|o|", $l, "\n";
    if ($l =~ m#^([\w\-]+):\s*(.*)#
        || $l =~ m#^([Xx]-[\w\-\.]+):\s*(.*)#          # private headers, some contain dots
       )
    {
      my ($header_tag, $header_line)= ($1, $2);
      $header_tag =~ tr/A-Z/a-z/;
      $hdr_obj=
      {
        'tag' => $header_tag,
        'line' => $header_line,
      };
      push (@{$HDR->{seq}}, $hdr_obj);
      $HDR->{name}->{$header_tag}= $hdr_obj;

      if ($header_tag eq 'return-path')
      {
        $HDR->{sender}= ($header_line =~ /<(.+)>/) ? $1 : $header_line;
      }
    }
    elsif ($l =~ /^\s+(.+)/)
    {
      $hdr_obj->{line} .= ' '. $1;
      # print " LINE='", $hdr_obj->{line},"]\n";
    }
    else
    {
      print "ATTN: header line not parsed! [$l]\n";
    }
  }

  $HDR;
}

# ----------------------------------------------------------------------
# formerly qf_to_HDR in mqsort.pl or mqsort
sub parse_qf
{
  my ($class, $qdir, $fnm)= @_;

  my $HDR= &new ();
  local *FI;
  open (FI, "$qdir/$fnm") || return undef;

  print "QF: $qdir/$fnm\n" if ($verbose);
  my ($sender, $last_hop_name, $last_hop_ip, $last_hop_user);
  my @recipients;
  my $lines;
  my ($header_tag, $header_line);
  
  my $hdr_obj;  # last header object processed;

  while (<FI>)
  {
    chop;
    $lines++;
    my $x= $_;
    $x=~ tr/A-Z/a-z/;

    if ($x =~ /^s(.*)/)
    {
      $sender= $1;
      $sender= $1 if ($sender =~ /^<(.+)>$/);
    }
    elsif ($x =~ /^t(\d+)/)
    {
      $HDR->{'TSTAMP'}= $1;
    }
    elsif ($x =~ /^r[pfd]*:(.*)/)
    {
      my $recipient= $1;
      $recipient= $1 if ($recipient =~ /^<(.+)>$/);
      push (@recipients, $recipient);
    }
    elsif ($x =~ /^\$_(.*)/)
    {
      my $last_hop= $1;
      ($last_hop_name, $last_hop_ip)= split (/\[/, $last_hop);
      ($last_hop_user, $last_hop_name)= ($1, $2) if ($last_hop_name =~ /(.+)\@(.*)/);
      $last_hop_name=~ s/\s*$//;
      $last_hop_ip=~ s/\].*$//;

      $HDR->{'last_hop_ip'}= $last_hop_ip;
      $HDR->{'last_hop_name'}= $last_hop_name;
      $HDR->{'last_hop_user'}= $last_hop_user;
    }
    elsif ($_ =~ m#^H([^:]+):\s*(.*)#)
    {
      ($header_tag, $header_line)= ($1, $2);
      $header_tag =~ tr/A-Z/a-z/;
      $hdr_obj=
      {
        'tag' => $header_tag,
        'line' => $header_line,
      };
      push (@{$HDR->{seq}}, $hdr_obj);
      $HDR->{name}->{$header_tag}= $hdr_obj;
    }
    elsif ($_ =~ /^\s+(.+)/)
    {
      $hdr_obj->{line} .= ' '. $1;
    }
  }
  close (FI);

  return undef if ($lines <= 10);

  $HDR->{'sender'}= $sender;
  $HDR->{'recipients'}= \@recipients;

  $HDR;
}

# ----------------------------------------------------------------------
sub get_field
{
  my $obj= shift;
  my $field_name= shift;

  return undef unless (exists ($obj->{'name'}->{$field_name}));
  my $m= $obj->{'name'}->{$field_name};
  return $m->{'line'};
}

# ----------------------------------------------------------------------
# returns last hop's address (see perldoc section below)
sub get_received
{
  my $obj= shift;
  my $upd= shift;

  my $m;

  return @{$obj->{'_first_received_'}} if (exists ($obj->{'_first_received_'}));

  my @res= qw(? ? ? ? ? ?);

  foreach $m (@{$obj->{seq}})
  {
    if ($m->{'tag'} eq 'received')
    {
      my $rec= $m->{'line'};

      print ">>>>>>> rec='$rec'\n" if ($verbose);

#\s*\(\[([\d\.]+)\]\) by ([\w\d\.\-]+)/)
if ($rec =~ /from (\S+)\s+\(HELO ([^)]*)\)\s*\(\[([\d\.]+)\]\) \(envelope-sender ([^)]+)\) by ([\w\d\.\-]+)/)
{
  my ($rdns, $c2b, $ip, $env, $h)= ($1, $2, $3, $4);
  print ">>>>>>> MATCH! rdns='$rdns' c2b='$c2b' ip='$ip' env='$env' h='$h'\n" if ($verbose);
}

      if ($rec =~ /from (\S+)\s+\((.*)\s*\[([\d\.]+)\]\) \(authenticated bits=0\) by ([\w\d\.\-]+)/)
      {
        my ($c2b, $rdns, $ip, $h)= ($1, $2, $3, $4);

        if ($h =~ /\.wu-wien\.ac\.at$/)
	{
          my ($gate, $trid);
          if ($rec =~ /by\s+(\S+)\s+.*with E?SMTP id (\w+)/)
	  {
	    ($gate, $trid)= ($1, $2);
	  }
          $obj->{'_SMTP_AUTH_'}= $h;

print __LINE__, " SMTP AUTH via $gate\n";
          @res= ($ip, $rdns, $c2b, $gate, $trid);
          last;
	}
      }

      if ($rec =~ /from (\S+)\s+\((.*)\s*\[([\d\.]+)\]\) by ([\w\d\.\-]+)/
          || $rec =~ /from (\S+)\s+\((.*)\s*\[([\d\.]+)\] \(may be forged\)\) by ([\w\d\.\-]+)/
         )
      {
        my ($c2b, $rdns, $ip, $h)= ($1, $2, $3, $4);
        # TODO: check for well known hosts and skip them
	      next if (exists ($IP_HOP_OK{$ip}));

        $rdns=~ s/.*\@//;
        $rdns=~ s/\s+//;
        print ">>> c2b='$c2b' rdns='$rdns' ip='$ip' h='$h'\n" if ($verbose);

        if ($rec =~ /with HTTP/ && $rdns eq '')
        { # webmail system (is it IMP ?) does not record rdns!
          $rdns= `host $ip`;
          $rdns= ($rdns =~ /(.*) is [\d\.]+/) ? $1 : '';
        }

        my ($gate, $trid);
        if ($rec =~ /by\s+(\S+)\s+.*with E?SMTP id (\w+)/)
	{
	  ($gate, $trid)= ($1, $2);
	}

       
        my $date= '?';
        if ($rec =~ /((Mon|Tue|Wed|Thu|Fri|Sat|Sun),[^\)]+\))/)
	{
          $date= $1;
	}
# print ">>> rec='$rec'\n>>>> date='$date'\n";

        @res= ($ip, $rdns, $c2b, $gate, $trid, $date);
        last;
      }
    }
  }

  $obj->{'_first_received_'}= \@res;
  if ($upd)
  {
    $obj->{'last_hop_ip'}= $res[0];
    $obj->{'last_hop_name'}= $res[2];
  }

  return @res;
}

# ----------------------------------------------------------------------
sub is_virus_fnm
{
  my $fnm= shift;

  $fnm=~ tr/a-z/A-Z/;
  print ">> virus-fnm check: fnm='$fnm'\n";
  return 'virus' if (exists ($VIRUSES{$fnm}));

  my @fnm= split (/\./, $fnm);
  return 'virus' if (exists ($BADTRANS_part1{$fnm[0]})
                     && exists ($BADTRANS_part2{$fnm[1]})
                     && exists ($BADTRANS_part3{$fnm[2]}));

  return undef;
}

# ----------------------------------------------------------------------
sub is_virus
{
  my $obj= shift;

  my $ctdis= $obj->get_field ('content-disposition');
  my ($ext, $fnm)= &extract_file_extension ($ctdis);

  if ($ext eq 'NONE')
  {
    my $ctty= $obj->get_field ('content-type');
    ($ext, $fnm)= &extract_file_extension ($ctty);
  }

  return ('virus', $ext, $fnm) if (&is_virus_fnm ($fnm));
  return ('ok', $ext, $fnm);
}

# ----------------------------------------------------------------------
sub is_virus_boundary
{
  my $b= shift;

  return 1
    if ($b eq '==i3.9.0oisdboibsd\(\(kncd'
        || $b =~ /^--VE[A-Z\d]{33}$/  # ha...@se...
        || $b =~ /^--VE[A-Z\d]+$/  # Variante davon
        || $b =~ /^-+[\dA-F]+_Outlook_Express_message_boundary$/ # W32.sircam Virus
        || $b =~ /====_ABC1234567890DEF_====/   # nimda Virus/Worm
       );

  return undef;
}

# ----------------------------------------------------------------------
# this operates on header-descriptor only
sub identify_mime_part
{
  my $obj= shift;

  my $ctty= $obj->get_field ('content-type');
  return ('empty', 'empty') unless ($ctty);

  print "CTTY: ", $ctty, "\n";

  if ($ctty =~ m#multipart/#i)
  {
    if ($ctty =~ m#boundary="([^"]+)"#i
        || $ctty =~ m#boundary=([^\s]+)#i
       )
    {
      my $boundary= $1;

print ">>> boundary='$boundary'\n";
      return 'virus-check' if (&is_virus_boundary ($boundary));
      return ('multipart', $boundary);
    }
    return 'mime-error';
  }
  elsif ($ctty =~ m#application/([^;\s]+)#)
  {
    my $app_type= $1;

    my ($vx, $ext, $fnm)= &is_virus ($obj);
    return ('virus', $fnm) if ($vx eq 'virus');

    # translate some app_types
    if ($app_type eq 'octet-stream' || $app_type eq 'octetstream'
        || $app_type eq 'x-msdownload'   # ?????? T2D
       )
    {
      # Grrr!
print ">>> app_type='$app_type' ext='$ext'\n";
      return ('video', 'x-avi') if ($ext eq 'avi');
      return ('application', 'pgp-signature') if ($ext eq 'pgp');
      return ('image', 'gif') if ($ext eq 'gif');
      return ('image', 'jpeg') if ($ext eq 'jpg');
      return ('text', 'html') if ($ext eq 'htm');

      $app_type= 'x-zip-compressed' if ($ext eq 'zip');
      $app_type= 'x-pdf' if ($ext eq 'pdf');
      $fnm=~ tr/A-Z/a-z/;
      $app_type= 'x-antivir' if (exists ($ANTIVIR_FNM{$fnm})); # T2D
    }
    elsif ($app_type eq 'msword')
    {
      $app_type= 'x-rtf' if ($ext eq 'rtf');
    }

    return ('application', $app_type);
  }
  elsif ($ctty =~ m#image/([^;\s]+)#)
  { # should be ok.
    my $type= $1;

    # CHECK if filename is not compatible!
    my ($vx, $ext, $fnm)= &is_virus ($obj);
    return ('virus', $fnm) if ($vx eq 'virus');

    unless (exists ($IMAGE_EXT{$ext}))
    {
      return ('mime-fake', $fnm);
    }
    return ('image', $type);
  }
  elsif ($ctty =~ m#(audio|video)/([^;\s]+)#)
  { # should be ok.
    my ($m1, $type)= ($1, $2);
    $m1=~ tr/A-Z/a-z/;
    $type=~ tr/A-Z/a-z/;

    # CHECK if filename is not compatible!
    my ($vx, $ext, $fnm)= &is_virus ($obj);
    return ('virus', $fnm) if ($vx eq 'virus');

    return ('mime-fake', $fnm)
      unless (($m1 eq 'audio' && exists ($AUDIO_EXT{$ext}))
              || ($m1 eq 'video' && exists ($VIDEO_EXT{$ext}))
             );

    return ($m1, $type);
  }
  elsif ($ctty =~ m#(text|message)/([^;\s]+)#i)
  {
    my ($m1, $type)= ($1, $2);
    $m1=~ tr/A-Z/a-z/;
    $type=~ tr/A-Z/a-z/;
    return ($m1, $type);
  }
  
  return ('mime-unknown', $ctty);
}

# ----------------------------------------------------------------------
sub mime_test
{
  my $obj= shift;
  
  my $m= $obj->{name}->{'X-WU-MIME'};
  print ">>>>> HDR.pm(L266): m=$m\n";
  if ($m)
  {
    # my $check= $obj->{name}->{'X-WU-MIME'}->{line};
    my $check= $m->{line};
    if ($check)
    {
      print ">>>>>> check=$check\n";
      my ($res, $res2)= split (' ', $check);
      return $res2 if ($res2 eq 'mime-fake');
      return $res unless ($res eq 'ok');
    }
  }

  my $l= $obj->{parts};
  my $x;
  foreach $x (@$l)
  {
    my $res= $x->mime_test;
    return $res unless ($res eq 'ok');
  }

  return 'ok';
}

# ----------------------------------------------------------------------
sub show_structure
{
  my $obj= shift;
  my $indent= shift;

  # print "showing structure $indent $obj\n";

  my $x;
  my $l= $obj->{seq};
  foreach $x (@$l)
  {
    next if ($x->{tag} eq 'received');
    print ' 'x$indent, $x->{tag}, ': ', $x->{line}, "\n";
  }

  my $l= $obj->{parts};
  my $parts= 0;
  foreach $x (@$l)
  {
    print ' 'x$indent, "part nr.: ", ++$parts, "\n";
    $x->show_structure ($indent+2);
    print "\n";
  }
  print "\n";
}

# ----------------------------------------------------------------------
sub extract_file_extension
{
  my $disposition= shift; # Disposition header
  if ($disposition =~ /name="([^"]+)"/
      || $disposition =~ /name=([^\s]+)/
     )
  {
    my $fnm= $1;
    if ($fnm =~ /^=\?iso-8859-\d\?Q\?(.+)\?=$/)
    {
      $fnm= $1;
      $fnm=~ s/=([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
print ">>>>> translated: fnm='$fnm'\n";
    }

    my @fnm= split (/\./, $fnm);
    my $ext= pop (@fnm);
    $ext =~ tr/A-Z/a-z/;
    return ($ext, $fnm);
  }
  return ('NONE', 'NONE');
}

sub rfc822_date_localtime
{
  my $str= shift;

  if ($str =~ m#^(\w+), +(\d+) (\w+) (\d+) +(\d+):(\d+):(\d+) (\S+)$#)
  {
    my ($wday, $mday, $mon_s, $year, $hr, $min, $sec, $tz_str)= ($1, $2, $3, $4, $5, $6, $7, $8);
    $mon_s =~ tr/A-Z/a-z/;

    my $mon= $MON{$mon_s}; # TODO: don't be case sensitive!
    return ($sec, $min, $hr, $mday, $mon, $year-1900, $wday);
  }
  else
  {
    print "unknown date string: [$str]\n";
  }

  return undef;
}

1;
__END__

=head1 NAME

  Util::Mail::Processor.pm  -- mail (header) processing

=head1 SYNOPSIS

=head2 new

  my $hdr= new Util::Mail::Processor ();

  creates empty object

=head2 analyze_header

  my $hdr= analyze_header Util::Mail::Processor (\@mail);

  analyzes a mails header and isolates fields of interest

=head2 parse_qf

  my $hdr= parse_qf Util::Mail::Processor ($filename);

  parses a sendmail qf file

=head2 get_received

  my @lhop= $hdr->get_received ($upd);

  Analyzes received headers to determine the last hop of a given
  mail.  The last hop should be the mail server that handed the
  mail to the first server in our realm which may be comprised of
  several domains.

  A true value of $upd indicates, that last hop address attributes
  in the HDR object should be updated.  These fields are only
  set by the parse_qf method.

=head3 return values

  [0] last hop IP address
  [1] last hop IP host name
  [2] HELO string used by sending server
  [3] first host in our realm
  [4] transaction ID

  A return value of qw(? ? ?) is used for mails that were generated
  within our realm.

=head1 BUGS

  Poor documentation and lazy author :-/

=head1 PLANS

  There are many site specific elements that need to be restructured and refactored into
  a plug-in style module.

=head1 AUTHOR

  Gerhard Gonter <gg...@cp...>

[aix-pm-cvs] modules/util/Util/Mail - New directory

From: Gerhard G. <go...@us...> - 2015-09-08 16:10:41

Update of /cvsroot/aix-pm/modules/util/Util/Mail
In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv5375/modules/util/Util/Mail

Log Message:
Directory /cvsroot/aix-pm/modules/util/Util/Mail added to the repository

[aix-pm-cvs] modules/util/Util MongoDB.pm,1.4,1.5

From: Gerhard G. <go...@us...> - 2015-09-04 16:25:42

Update of /cvsroot/aix-pm/modules/util/Util
In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv7820/modules/util/Util

Modified Files:
	MongoDB.pm 
Log Message:
added pod section for merge()

Index: MongoDB.pm
===================================================================
RCS file: /cvsroot/aix-pm/modules/util/Util/MongoDB.pm,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** MongoDB.pm	4 Sep 2015 16:09:27 -0000	1.4
--- MongoDB.pm	4 Sep 2015 16:25:40 -0000	1.5
***************
*** 105,108 ****
--- 105,117 ----
  }
  
+ =head2 $updates= merge ($target, $source)
+ 
+ Merge or unify two hash references recursively: $target will be updated
+ with fields from $source.
+ 
+ This might be useful also not only in a MongoDB context.
+ 
+ =cut
+ 
  sub merge
  {
***************
*** 129,132 ****
--- 138,142 ----
        else
        { # hmm... maybe a warning is in order here?
+         # we are replacing the field in target!
          $target->{$an}= $source->{$an};
          $upd++;
***************
*** 134,138 ****
      }
      else
!     {
        $target->{$an}= $source->{$an};
        $upd++;
--- 144,148 ----
      }
      else
!     { # simply add a new field to the target structure.
        $target->{$an}= $source->{$an};
        $upd++;

[aix-pm-cvs] modules/util/Util MongoDB.pm,1.3,1.4

From: Gerhard G. <go...@us...> - 2015-09-04 16:09:29

Update of /cvsroot/aix-pm/modules/util/Util
In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv7035/modules/util/Util

Modified Files:
	MongoDB.pm 
Log Message:
merge function refactored from IRMA module

Index: MongoDB.pm
===================================================================
RCS file: /cvsroot/aix-pm/modules/util/Util/MongoDB.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** MongoDB.pm	2 Jan 2014 20:23:34 -0000	1.3
--- MongoDB.pm	4 Sep 2015 16:09:27 -0000	1.4
***************
*** 105,108 ****
--- 105,146 ----
  }
  
+ sub merge
+ {
+   my $target= shift;
+   my $source= shift;
+ 
+   my $upd= 0;
+   print "source=[$source]\n";
+   foreach my $an (keys %$source)
+   {
+     next if ($an eq '_id');
+     # TODO: check if the target and source are itself a structure
+     if (exists ($target->{$an}))
+     {
+       if (ref ($target->{$an}) eq 'HASH' && ref ($source->{$an}) eq 'HASH')
+       {
+         $upd += merge ($target->{$an}, $source->{$an});
+       }
+       # TODO: how about arrays?
+       elsif ($target->{$an} eq $source->{$an})
+       {
+         # print "NOTE: no change\n";
+       }
+       else
+       { # hmm... maybe a warning is in order here?
+         $target->{$an}= $source->{$an};
+         $upd++;
+       }
+     }
+     else
+     {
+       $target->{$an}= $source->{$an};
+       $upd++;
+     }
+   }
+ 
+   $upd;
+ }
+ 
  1;

[aix-pm-cvs] modules/util/Util Matrix.pm,1.9,1.10

From: Gerhard G. <go...@us...> - 2015-07-12 00:32:13

Update of /cvsroot/aix-pm/modules/util/Util
In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv20131

Modified Files:
	Matrix.pm 
Log Message:
add an optional output filehandle for matrix output

Index: Matrix.pm
===================================================================
RCS file: /cvsroot/aix-pm/modules/util/Util/Matrix.pm,v
retrieving revision 1.9
retrieving revision 1.10
diff -C2 -d -r1.9 -r1.10
*** Matrix.pm	5 Nov 2013 17:14:23 -0000	1.9
--- Matrix.pm	12 Jul 2015 00:32:10 -0000	1.10
***************
*** 23,26 ****
--- 23,27 ----
    my $column_names= shift;
    my $d= shift;
+   my $fh= shift || *STDOUT;
  
    my @l= get_column_lengths ([$column_names], $d);
***************
*** 46,62 ****
      my $i= 0;
  
!     print $hl, "\n" if ($border_lines);
  
!     print $border_left if ($border_left);
      foreach my $n (@$column_names)
      {
!       print $border_inter if ($i);
!       printf ($fmt_l[$i], $n);
        $i++;
      }
!     print $border_right if ($border_right);
  
!     print "\n";
!     print $hl, "\n" if ($border_lines);
    }
  
--- 47,63 ----
      my $i= 0;
  
!     print $fh $hl, "\n" if ($border_lines);
  
!     print $fh $border_left if ($border_left);
      foreach my $n (@$column_names)
      {
!       print $fh $border_inter if ($i);
!       printf $fh ($fmt_l[$i], $n);
        $i++;
      }
!     print $fh $border_right if ($border_right);
  
!     print $fh "\n";
!     print $fh $hl, "\n" if ($border_lines);
    }
  
***************
*** 64,81 ****
    {
      my $i= 0;
!     print $border_left if ($border_left);
      foreach my $col (@$row)
      {
!       print $border_inter if ($i);
        # printf ((($col =~ /^-?\d+(\.\d+)?$/) ? $fmt_r[$i] : $fmt_l[$i]), $col);
        # printf ((($col =~ /^-?\d+$/) ? $fmt_r[$i] : $fmt_l[$i]), $col);
!       printf ($fmt_l[$i], $col);
        $i++;
      }
!     print $border_right if ($border_right);
!     print "\n";
    }
  
!   print $hl, "\n" if ($border_lines);
  }
  
--- 65,82 ----
    {
      my $i= 0;
!     print $fh $border_left if ($border_left);
      foreach my $col (@$row)
      {
!       print $fh $border_inter if ($i);
        # printf ((($col =~ /^-?\d+(\.\d+)?$/) ? $fmt_r[$i] : $fmt_l[$i]), $col);
        # printf ((($col =~ /^-?\d+$/) ? $fmt_r[$i] : $fmt_l[$i]), $col);
!       printf $fh ($fmt_l[$i], $col);
        $i++;
      }
!     print $fh $border_right if ($border_right);
!     print $fh "\n";
    }
  
!   print $fh $hl, "\n" if ($border_lines);
  }

[aix-pm-cvs] modules/util/Util Filesystems.pm, 1.5, 1.6 Monitoring.pm, 1.4, 1.5

From: Gerhard G. <go...@us...> - 2014-12-31 05:29:37

Update of /cvsroot/aix-pm/modules/util/Util
In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv14255/modules/util/Util

Modified Files:
	Filesystems.pm Monitoring.pm 
Log Message:
less debugging

Index: Filesystems.pm
===================================================================
RCS file: /cvsroot/aix-pm/modules/util/Util/Filesystems.pm,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** Filesystems.pm	31 Dec 2014 03:15:45 -0000	1.5
--- Filesystems.pm	31 Dec 2014 05:29:35 -0000	1.6
***************
*** 130,139 ****
     if (open (PM, '/proc/mounts'))
     {
!     print "reading /proc/mounts\n";
      FS2: while (<PM>)
      {
        chop;
!       print ">>> [$_]\n";
        my ($fs_spec, $fs_file, $fs_type, $fs_opts, $l1, $l2)= split (' ', $_, 6);
      if (exists($ignore_fs_type{$fs_type}))
      {
--- 130,140 ----
     if (open (PM, '/proc/mounts'))
     {
!     # print "reading /proc/mounts\n";
      FS2: while (<PM>)
      {
        chop;
!       # print ">>> [$_]\n";
        my ($fs_spec, $fs_file, $fs_type, $fs_opts, $l1, $l2)= split (' ', $_, 6);
+ 
      if (exists($ignore_fs_type{$fs_type}))
      {
***************
*** 148,157 ****
        foreach my $opt (@opts)
        {
!         print "opt=[$opt]\n";
          my ($an, $av)= split ('=', $opt, 2);
          $av= 1 unless (defined ($av));
          $opts{$an}= $av;
        }
!       print "opts: ", main::Dumper (\%opts);
  
        my $x= $fs{$fs_file}=
--- 149,158 ----
        foreach my $opt (@opts)
        {
!         # print "opt=[$opt]\n";
          my ($an, $av)= split ('=', $opt, 2);
          $av= 1 unless (defined ($av));
          $opts{$an}= $av;
        }
!       # print "opts: ", main::Dumper (\%opts);
  
        my $x= $fs{$fs_file}=

Index: Monitoring.pm
===================================================================
RCS file: /cvsroot/aix-pm/modules/util/Util/Monitoring.pm,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** Monitoring.pm	31 Dec 2014 03:16:08 -0000	1.4
--- Monitoring.pm	31 Dec 2014 05:29:35 -0000	1.5
***************
*** 130,135 ****
      my $n_events= setup_default_collection ($paf, 'events');
  
!     print "paf: ", Dumper ($paf);
!     print "n_mon=[$n_mon] n_events=[$n_events]\n";
  
      my ($mdb, $c_moni)= Util::MongoDB::connect ($paf, $n_mon);
--- 130,135 ----
      my $n_events= setup_default_collection ($paf, 'events');
  
!     # print "paf: ", Dumper ($paf);
!     # print "n_mon=[$n_mon] n_events=[$n_events]\n";
  
      my ($mdb, $c_moni)= Util::MongoDB::connect ($paf, $n_mon);
***************
*** 167,171 ****
    }
  
!   print __LINE__, " ref: ", Dumper ($ref);
    $ref;
  }
--- 167,171 ----
    }
  
!   # print __LINE__, " ref: ", Dumper ($ref);
    $ref;
  }
***************
*** 202,206 ****
    $filesystems->df('i');
    # $filesystems->df('h');
!   print "filesystems: ", Dumper ($filesystems);
  
    my $worst_status= -1;
--- 202,206 ----
    $filesystems->df('i');
    # $filesystems->df('h');
!   # print "filesystems: ", Dumper ($filesystems);
  
    my $worst_status= -1;
***************
*** 210,217 ****
    my $fs_hash= $filesystems->{'fs'};
    my %ro_fs;
!   print __LINE__, " checking fs_hash: ", main::Dumper($fs_hash);
    foreach my $fs (keys %$fs_hash)
    {
!     print __LINE__, " fs=[$fs]\n";
      my $x_fs= $fs_hash->{$fs};
      # print "x_fs($fs): ", Dumper ($x_fs);
--- 210,217 ----
    my $fs_hash= $filesystems->{'fs'};
    my %ro_fs;
!   # print __LINE__, " checking fs_hash: ", main::Dumper($fs_hash);
    foreach my $fs (keys %$fs_hash)
    {
!     # print __LINE__, " fs=[$fs]\n";
      my $x_fs= $fs_hash->{$fs};
      # print "x_fs($fs): ", Dumper ($x_fs);
***************
*** 252,256 ****
                    { 'upsert' => 1 }
                   );
!     print __LINE__, " rc=[$rc]\n";
    }
  
--- 252,256 ----
                    { 'upsert' => 1 }
                   );
!     # print __LINE__, " rc=[$rc]\n";
    }
  
***************
*** 266,270 ****
  
    my $event_id= $events->insert($ev);
!   print "event_id: ", Dumper ($event_id);
  
    if (1)
--- 266,270 ----
  
    my $event_id= $events->insert($ev);
!   # print "event_id: ", Dumper ($event_id);
  
    if (1)

[aix-pm-cvs] modules/util/Util ts.pm,1.4,1.5

From: Gerhard G. <go...@us...> - 2014-12-31 03:35:36

Update of /cvsroot/aix-pm/modules/util/Util
In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv11268/modules/util/Util

Modified Files:
	ts.pm 
Log Message:
added ts_ISO2_gmt()

Index: ts.pm
===================================================================
RCS file: /cvsroot/aix-pm/modules/util/Util/ts.pm,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** ts.pm	22 Aug 2012 14:49:39 -0000	1.4
--- ts.pm	31 Dec 2014 03:35:34 -0000	1.5
***************
*** 9,13 ****
  
  @ISA= qw(Exporter);
! @EXPORT= qw(ts ts_date ts_ISO ts_pg);
  
  sub ts
--- 9,13 ----
  
  @ISA= qw(Exporter);
! @EXPORT= qw(ts ts_date ts_ISO ts_ISO2_gmt ts_pg);
  
  sub ts
***************
*** 34,37 ****
--- 34,45 ----
  }
  
+ sub ts_ISO2_gmt
+ {
+   my $time= shift || time ();
+   my @ts= gmtime ($time);
+   sprintf ("%04d-%02d-%02dT%02d:%02d:%02d.000Z",
+            $ts[5]+1900, $ts[4]+1, $ts[3], $ts[2], $ts[1], $ts[0]);
+ }
+ 
  sub ts_pg
  {

[aix-pm-cvs] modules/util/Util Monitoring.pm,1.3,1.4

From: Gerhard G. <go...@us...> - 2014-12-31 03:16:11

Update of /cvsroot/aix-pm/modules/util/Util
In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv10759/modules/util/Util

Modified Files:
	Monitoring.pm 
Log Message:
debugging messages

Index: Monitoring.pm
===================================================================
RCS file: /cvsroot/aix-pm/modules/util/Util/Monitoring.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** Monitoring.pm	30 Dec 2014 09:43:27 -0000	1.3
--- Monitoring.pm	31 Dec 2014 03:16:08 -0000	1.4
***************
*** 210,213 ****
--- 210,214 ----
    my $fs_hash= $filesystems->{'fs'};
    my %ro_fs;
+   print __LINE__, " checking fs_hash: ", main::Dumper($fs_hash);
    foreach my $fs (keys %$fs_hash)
    {
***************
*** 241,245 ****
         ($worst_status, $worst_msg)=   compare_levels([$worst_status, $worst_msg], [$nagios_status, $nagios_msg]);
  
!     $moni->update({ 'resource' => $x_fs->{'mp'} },
                    { 'resource' => $x_fs->{'mp'}, 'e' => $now, 'ts' => DateTime->from_epoch('epoch' => $now),
                      'nagios_status'      => $nagios_status[$nagios_status],
--- 242,246 ----
         ($worst_status, $worst_msg)=   compare_levels([$worst_status, $worst_msg], [$nagios_status, $nagios_msg]);
  
!     my $rc= $moni->update({ 'resource' => $x_fs->{'mp'} },
                    { 'resource' => $x_fs->{'mp'}, 'e' => $now, 'ts' => DateTime->from_epoch('epoch' => $now),
                      'nagios_status'      => $nagios_status[$nagios_status],
***************
*** 251,254 ****
--- 252,256 ----
                    { 'upsert' => 1 }
                   );
+     print __LINE__, " rc=[$rc]\n";
    }

[aix-pm-cvs] modules/util/Util Filesystems.pm,1.4,1.5

From: Gerhard G. <go...@us...> - 2014-12-31 03:15:48

Update of /cvsroot/aix-pm/modules/util/Util
In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv10731/modules/util/Util

Modified Files:
	Filesystems.pm 
Log Message:
update fs attribute

Index: Filesystems.pm
===================================================================
RCS file: /cvsroot/aix-pm/modules/util/Util/Filesystems.pm,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** Filesystems.pm	30 Dec 2014 09:42:51 -0000	1.4
--- Filesystems.pm	31 Dec 2014 03:15:45 -0000	1.5
***************
*** 155,158 ****
--- 155,159 ----
        print "opts: ", main::Dumper (\%opts);
  
+       my $x= $fs{$fs_file}=
        $dev{$fs_spec}= 
        {

[aix-pm-cvs] modules/util csv.pl,1.38,1.39

From: Gerhard G. <go...@us...> - 2014-12-30 09:43:38

Update of /cvsroot/aix-pm/modules/util
In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv12081/modules/util

Modified Files:
	csv.pl 
Log Message:
debugging messages

Index: csv.pl
===================================================================
RCS file: /cvsroot/aix-pm/modules/util/csv.pl,v
retrieving revision 1.38
retrieving revision 1.39
diff -C2 -d -r1.38 -r1.39
*** csv.pl	25 Sep 2014 17:37:42 -0000	1.38
--- csv.pl	30 Dec 2014 09:43:27 -0000	1.39
***************
*** 176,180 ****
  if (defined ($find_pattern))
  {
! # print "procssing find_pattern=[$find_pattern]\n";
    my $re= qr/$find_pattern/i;
  
--- 176,180 ----
  if (defined ($find_pattern))
  {
! print "procssing find_pattern=[$find_pattern]\n";
    my $re= qr/$find_pattern/i;

[aix-pm-cvs] modules/util/Util Monitoring.pm,1.2,1.3

From: Gerhard G. <go...@us...> - 2014-12-30 09:43:37

Update of /cvsroot/aix-pm/modules/util/Util
In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv12081/modules/util/Util

Modified Files:
	Monitoring.pm 
Log Message:
debugging messages

Index: Monitoring.pm
===================================================================
RCS file: /cvsroot/aix-pm/modules/util/Util/Monitoring.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** Monitoring.pm	25 Aug 2014 16:05:04 -0000	1.2
--- Monitoring.pm	30 Dec 2014 09:43:27 -0000	1.3
***************
*** 202,206 ****
    $filesystems->df('i');
    # $filesystems->df('h');
!   # print "filesystems: ", Dumper ($filesystems);
  
    my $worst_status= -1;
--- 202,206 ----
    $filesystems->df('i');
    # $filesystems->df('h');
!   print "filesystems: ", Dumper ($filesystems);
  
    my $worst_status= -1;
***************
*** 209,215 ****
    my $now= time ();
    my $fs_hash= $filesystems->{'fs'};
    foreach my $fs (keys %$fs_hash)
    {
!     # print "fs=[$fs]\n";
      my $x_fs= $fs_hash->{$fs};
      # print "x_fs($fs): ", Dumper ($x_fs);
--- 209,216 ----
    my $now= time ();
    my $fs_hash= $filesystems->{'fs'};
+   my %ro_fs;
    foreach my $fs (keys %$fs_hash)
    {
!     print __LINE__, " fs=[$fs]\n";
      my $x_fs= $fs_hash->{$fs};
      # print "x_fs($fs): ", Dumper ($x_fs);

[aix-pm-cvs] modules/util/Util Filesystems.pm,1.3,1.4

From: Gerhard G. <go...@us...> - 2014-12-30 09:42:54

Update of /cvsroot/aix-pm/modules/util/Util
In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv12035/modules/util/Util

Modified Files:
	Filesystems.pm 
Log Message:
Use Linux::Proc::Mounts only when available, otherwise read /proc/mounts
directly.  But then, why do we need that module anyway?
TODO: reconsider use of module



Index: Filesystems.pm
===================================================================
RCS file: /cvsroot/aix-pm/modules/util/Util/Filesystems.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** Filesystems.pm	25 Aug 2014 16:05:04 -0000	1.3
--- Filesystems.pm	30 Dec 2014 09:42:51 -0000	1.4
***************
*** 19,23 ****
  package Util::Filesystems;
  
- use Linux::Proc::Mounts;
  use Data::Dumper;
  $Data::Dumper::Indent= 1;
--- 19,22 ----
***************
*** 25,28 ****
--- 24,44 ----
  my $initialzed= 0;
  
+ my $have_LPM= 0;
+ 
+ BEGIN {
+ eval {
+ require Linux::Proc::Mounts;
+ };
+ 
+ if ($@)
+ {
+   print "consider to install Linux::Proc::Mounts\n";
+ }
+ else
+ {
+   $have_LPM= 1;
+ }
+ }
+ 
  my %setable= map { $_ => 1 } qw();
  
***************
*** 67,79 ****
    my $keep_mp_obj;
  
!   my $m = Linux::Proc::Mounts->read;
!   # print "m: ", main::Dumper ($m);
  
!   my %fs; $self->{'fs'}= \%fs;
!   my %dev; $self->{'device'}= \%dev;
!   my %c_fst; $self->{'c_fst'}= \%c_fst;
    my $count= 0;
!   FS: foreach my $mp (@$m)
    {
      my ($fs_spec, $fs_type)= ($mp->spec(), $mp->fstype());
      # print "fs_spec=[$fs_spec] fs_type=[$fs_type] mp: ", main::Dumper ($mp);
--- 83,102 ----
    my $keep_mp_obj;
  
!   my $m;
!   if ($have_LPM)
!   {
!     $m= Linux::Proc::Mounts->read;
!     # print "m: ", main::Dumper ($m);
!   }
  
!   my %fs;    $self->{'fs'}=     \%fs;
!   my %dev;   $self->{'device'}= \%dev;
!   my %c_fst; $self->{'c_fst'}=  \%c_fst;
    my $count= 0;
! 
!   if (defined ($m))
    {
+    FS: foreach my $mp (@$m)
+    {
      my ($fs_spec, $fs_type)= ($mp->spec(), $mp->fstype());
      # print "fs_spec=[$fs_spec] fs_type=[$fs_type] mp: ", main::Dumper ($mp);
***************
*** 101,104 ****
--- 124,171 ----
        $count++;
      }
+    }
+   }
+   else
+   {
+    if (open (PM, '/proc/mounts'))
+    {
+     print "reading /proc/mounts\n";
+     FS2: while (<PM>)
+     {
+       chop;
+       print ">>> [$_]\n";
+       my ($fs_spec, $fs_file, $fs_type, $fs_opts, $l1, $l2)= split (' ', $_, 6);
+     if (exists($ignore_fs_type{$fs_type}))
+     {
+       # print "ignoring [$fs_type] ", Dumper ($mp);
+       next FS2;
+     }
+     else
+     {
+       my @opts= split (',', $fs_opts);
+       # print "opts: [", join (';', @opts), "]\n";
+       my %opts;
+       foreach my $opt (@opts)
+       {
+         print "opt=[$opt]\n";
+         my ($an, $av)= split ('=', $opt, 2);
+         $av= 1 unless (defined ($av));
+         $opts{$an}= $av;
+       }
+       print "opts: ", main::Dumper (\%opts);
+ 
+       $dev{$fs_spec}= 
+       {
+         'mp'   => $fs_file,
+         'spec' => $fs_spec,
+         'type' => $fs_type,
+         'opts' => \%opts,
+       };
+       $c_fst{$fs_type}++;
+       $count++;
+     }
+     }
+     close (PM);
+    }
    }

[aix-pm-cvs] modules/util/Util Simple_CSV.pm,1.46,1.47

From: Gerhard G. <go...@us...> - 2014-11-04 07:36:07

Update of /cvsroot/aix-pm/modules/util/Util
In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv10206/modules/util/Util

Modified Files:
	Simple_CSV.pm 
Log Message:
Do not change undefined values! The caller needs to decide upon such cases!

Index: Simple_CSV.pm
===================================================================
RCS file: /cvsroot/aix-pm/modules/util/Util/Simple_CSV.pm,v
retrieving revision 1.46
retrieving revision 1.47
diff -C2 -d -r1.46 -r1.47
*** Simple_CSV.pm	3 Nov 2014 12:48:52 -0000	1.46
--- Simple_CSV.pm	4 Nov 2014 07:36:04 -0000	1.47
***************
*** 741,747 ****
  BUG:
  * only works with data records.
! * if the value of the index field is not defined, the record is index
!   under ''; (before a warning might have been emmitted)
    TODO: maybe a different default value should be used.
  
  =cut
--- 741,749 ----
  BUG:
  * only works with data records.
! * if the value of the index field is not defined, the record is
!   implicityly indexed under ''; (a warning might been emmitted)
    TODO: maybe a different default value should be used.
+   NOTE: the application owner should evaluate, why a field
+         with undefined values is indexed in the first place.
  
  =cut
***************
*** 757,762 ****
    foreach my $row (@{$csv->{'data'}})
    {
!     my $av= $row->{$field} || '';
      # DO NOT drop this row if $av is undefined!
      $av=~ tr/A-Z/a-z/ if ($lower);
      push (@{$IDX{$av}}, $row);
--- 759,765 ----
    foreach my $row (@{$csv->{'data'}})
    {
!     my $av= $row->{$field}; # || '';
      # DO NOT drop this row if $av is undefined!
+     # instead 
      $av=~ tr/A-Z/a-z/ if ($lower);
      push (@{$IDX{$av}}, $row);

[aix-pm-cvs] modules/util/Util Simple_CSV.pm,1.45,1.46

From: Gerhard G. <go...@us...> - 2014-11-03 12:48:55

Update of /cvsroot/aix-pm/modules/util/Util
In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv8585/Util

Modified Files:
	Simple_CSV.pm 
Log Message:
deal with undef index values

Index: Simple_CSV.pm
===================================================================
RCS file: /cvsroot/aix-pm/modules/util/Util/Simple_CSV.pm,v
retrieving revision 1.45
retrieving revision 1.46
diff -C2 -d -r1.45 -r1.46
*** Simple_CSV.pm	25 Sep 2014 17:16:05 -0000	1.45
--- Simple_CSV.pm	3 Nov 2014 12:48:52 -0000	1.46
***************
*** 739,743 ****
  index rows by given field name.  Use lowercase, if to_lower is true.
  
! BUG: only works with data records.
  
  =cut
--- 739,747 ----
  index rows by given field name.  Use lowercase, if to_lower is true.
  
! BUG:
! * only works with data records.
! * if the value of the index field is not defined, the record is index
!   under ''; (before a warning might have been emmitted)
!   TODO: maybe a different default value should be used.
  
  =cut
***************
*** 753,757 ****
    foreach my $row (@{$csv->{'data'}})
    {
!     my $av= $row->{$field};
      $av=~ tr/A-Z/a-z/ if ($lower);
      push (@{$IDX{$av}}, $row);
--- 757,762 ----
    foreach my $row (@{$csv->{'data'}})
    {
!     my $av= $row->{$field} || '';
!     # DO NOT drop this row if $av is undefined!
      $av=~ tr/A-Z/a-z/ if ($lower);
      push (@{$IDX{$av}}, $row);

[aix-pm-cvs] modules/util csv.pl,1.37,1.38

From: Gerhard G. <go...@us...> - 2014-09-25 17:37:44

Update of /cvsroot/aix-pm/modules/util
In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv16817

Modified Files:
	csv.pl 
Log Message:
callback function names need to be different; case insensitive regular expression compilation

Index: csv.pl
===================================================================
RCS file: /cvsroot/aix-pm/modules/util/csv.pl,v
retrieving revision 1.37
retrieving revision 1.38
diff -C2 -d -r1.37 -r1.38
*** csv.pl	25 Sep 2014 17:16:04 -0000	1.37
--- csv.pl	25 Sep 2014 17:37:42 -0000	1.38
***************
*** 172,181 ****
  }
  
  if (defined ($find_pattern))
  {
!   my $re= qr($find_pattern);
  
  =begin comment
  
    my $filter=
      sub
--- 172,185 ----
  }
  
+ # print "find_pattern=[$find_pattern] search_string=[$search_string]\n";
+ 
  if (defined ($find_pattern))
  {
! # print "procssing find_pattern=[$find_pattern]\n";
!   my $re= qr/$find_pattern/i;
  
  =begin comment
  
+   # define search filter function
    my $filter=
      sub
***************
*** 185,189 ****
        my $row= shift;
        print "ROW: ", Dumper ($row);
!       foreach my $f (@$row) { return 1 if ($f =~ m#$re#i); };
        return 0;
      };
--- 189,193 ----
        my $row= shift;
        print "ROW: ", Dumper ($row);
!       foreach my $f (@$row) { return 1 if ($f =~ m#$re#); };
        return 0;
      };
***************
*** 194,202 ****
  =cut
  
!   sub fidef
    {
        my $obj= shift;
        my $cols= $obj->{'columns'};
!       print "cols: ", Dumper ($cols);
  
        my $fidef=
--- 198,208 ----
  =cut
  
!   # define search filter definition!
!   # (This filter is defined *after* the columns were identified)
!   sub fidef1
    {
        my $obj= shift;
        my $cols= $obj->{'columns'};
!       # print "cols: ", Dumper ($cols);
  
        my $fidef=
***************
*** 205,222 ****
            my $row= shift;
            # print "ROW: ", Dumper ($row);
!           foreach my $f (@$row) { return 1 if ($f =~ m#$re#i); };
            return 0;
          };
  
    };
  
!   $csv->set ('fidef' => \&fidef);
  }
  
  if (defined ($search_string))
  {
    my ($field_name, $field_value)= split ('=', $search_string, 2);
  
!   sub fidef
    {
      my $obj= shift;
--- 211,232 ----
            my $row= shift;
            # print "ROW: ", Dumper ($row);
!           foreach my $f (@$row) { return 1 if ($f =~ m#$re#); };
            return 0;
          };
  
+     return $fidef;
    };
  
!   $csv->set ('fidef' => \&fidef1);
  }
  
  if (defined ($search_string))
  {
+ # print "procssing search_string=[$search_string]\n";
    my ($field_name, $field_value)= split ('=', $search_string, 2);
  
!   # the filter is dynamically generated since the field number is only
!   # known after the column names are identified!
!   sub fidef2
    {
      my $obj= shift;
***************
*** 242,246 ****
    };
  
!   $csv->set ('fidef' => \&fidef);
  }
  
--- 252,256 ----
    };
  
!   $csv->set ('fidef' => \&fidef2);
  }

[aix-pm-cvs] modules/util/Util Simple_CSV.pm,1.44,1.45

From: Gerhard G. <go...@us...> - 2014-09-25 17:16:07

Update of /cvsroot/aix-pm/modules/util/Util
In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv15471/Util

Modified Files:
	Simple_CSV.pm 
Log Message:
added filter and search options which are handled via (dynamically generated) callback functions

Index: Simple_CSV.pm
===================================================================
RCS file: /cvsroot/aix-pm/modules/util/Util/Simple_CSV.pm,v
retrieving revision 1.44
retrieving revision 1.45
diff -C2 -d -r1.44 -r1.45
*** Simple_CSV.pm	8 Jun 2014 17:52:48 -0000	1.44
--- Simple_CSV.pm	25 Sep 2014 17:16:05 -0000	1.45
***************
*** 194,236 ****
    unless ($obj->{'no_headings'})
    {
!   # TODO: make column header reading optional
!   my $columns= <FI>;
!   unless ($columns)
!   {
!     $obj->{'ERROR'}= "no column header";
!     return undef;
!   }
  
!   if ($obj->{'UTF8'})
!   {
!     my $c1= substr ($columns, 0, 1);
!     my $o1= ord ($c1);
!     # print "c1=[$c1] o1=[$o1]\n"; hexdump ($c1);
!     if ($o1 eq 0xFEFF)
      {
!       $columns= substr ($columns, 1);
!       # print "BOM removed\n"; hexdump ($columns);
      }
-   }
  
-   chomp ($columns);
-   $columns=~ s/\r$//;
-   my @columns;
-   my ($sep, $strip)= map { $obj->{$_} } qw(separator strip_quotes);
-   if ($sep eq 'wiki')
-   {
-     @columns= split_wiki_header ($columns);
-   }
-   elsif ($sep eq 'awk')
-   {
-     @columns= split (' ', $columns);
-   }
-   else
-   {
-     @columns= split (/$sep/, $columns);
-     @columns= &strip_row (@columns) if ($strip);
-   }
  print __LINE__, " columns: ", join (', ', @columns), "\n" if ($DEBUG > 1);
!   $obj->define_columns (@columns);
    }
  
--- 194,245 ----
    unless ($obj->{'no_headings'})
    {
!     # TODO: make column header reading optional
!     my $columns= <FI>;
!     unless ($columns)
!     {
!       $obj->{'ERROR'}= "no column header";
!       return undef;
!     }
  
!     if ($obj->{'UTF8'})
      {
!       my $c1= substr ($columns, 0, 1);
!       my $o1= ord ($c1);
!       # print "c1=[$c1] o1=[$o1]\n"; hexdump ($c1);
!       if ($o1 eq 0xFEFF)
!       {
!         $columns= substr ($columns, 1);
!         # print "BOM removed\n"; hexdump ($columns);
!       }
!     }
! 
!     chomp ($columns);
!     $columns=~ s/\r$//;
!     my @columns;
! 
!     my ($sep, $strip, $fidef)= map { $obj->{$_} } qw(separator strip_quotes fidef);
! 
!     if ($sep eq 'wiki')
!     {
!       @columns= split_wiki_header ($columns);
!     }
!     elsif ($sep eq 'awk')
!     {
!       @columns= split (' ', $columns);
!     }
!     else
!     {
!       @columns= split (/$sep/, $columns);
!       @columns= &strip_row (@columns) if ($strip);
      }
  
  print __LINE__, " columns: ", join (', ', @columns), "\n" if ($DEBUG > 1);
!     $obj->define_columns (@columns);
! 
!     if (defined ($fidef))
!     {
!       my $filter= &$fidef ($obj); # EXPERIMENTAL: callback defines filter callback!
!       $obj->set ('filter' => $filter);
!     }
    }
  
***************
*** 245,255 ****
    local *FI= shift;
  
!   my ($no_hash, $no_array, $sep, $columns, $strip)=
!       map { $obj->{$_} } qw(no_hash no_array separator columns strip_quotes);
  
    my @rows= ();
    my @data= ();
    my $row_count= 0;
!   while (<FI>)
    {
      chomp;
--- 254,264 ----
    local *FI= shift;
  
!   my ($no_hash, $no_array, $sep, $columns, $strip, $filter)=
!       map { $obj->{$_} } qw(no_hash no_array separator columns strip_quotes filter);
  
    my @rows= ();
    my @data= ();
    my $row_count= 0;
!   ROW: while (<FI>)
    {
      chomp;
***************
*** 272,275 ****
--- 281,290 ----
  print __LINE__, " row: ", join (', ', @row), "\n" if ($DEBUG > 1);
  
+     if (defined ($filter))
+     {
+       my $take_it= &$filter (\@row);
+       next ROW unless ($take_it);
+     }
+ 
      push (@rows, \@row) unless ($no_array);

[aix-pm-cvs] modules/util csv.pl,1.35,1.36

From: Gerhard G. <go...@us...> - 2014-09-06 10:10:24

Update of /cvsroot/aix-pm/modules/util
In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv17283/modules/util

Modified Files:
	csv.pl 
Log Message:
option handling simplified

Index: csv.pl
===================================================================
RCS file: /cvsroot/aix-pm/modules/util/csv.pl,v
retrieving revision 1.35
retrieving revision 1.36
diff -C2 -d -r1.35 -r1.36
*** csv.pl	16 Aug 2014 11:10:01 -0000	1.35
--- csv.pl	6 Sep 2014 10:10:22 -0000	1.36
***************
*** 87,118 ****
  my $all= 0; # for extend view, sofar...
  
  my @PAR= ();
  while (defined (my $arg= shift (@ARGV)))
  {
!   if ($arg =~ /^-/)
    {
!     if ($arg eq '--merge') { $op_mode= 'merge'; $view= 'no'; }
!     elsif ($arg eq '--dump') { $DUMP_FILE= shift (@ARGV); }
!     elsif ($arg eq '--out') { $out_file= shift (@ARGV); }
!     elsif ($arg eq '--hdr') { $view= 'header'; }
!     elsif ($arg eq '--json') { $view= 'json'; }
!     elsif ($arg eq '--dumper') { $view= 'dumper'; }
!     elsif ($arg eq '--setcol') { push (@set_columns, split (',', shift (@ARGV))); }
!     elsif ($arg eq '--col') { push (@columns, split (',', shift (@ARGV))); }
!     elsif ($arg eq '--sort') { push (@sort_columns, split (',', shift (@ARGV))); }
!     elsif ($arg eq '--num') { $sort_numeric= 1; }
!     elsif ($arg eq '-q') { $strip_quotes= 1; }
!     elsif ($arg eq '-a') { $all= 1; }
!     elsif ($arg eq '-x') { $view= 'extended'; }
!     elsif ($arg eq '-J') { $view= 'json'; }
!     elsif ($arg eq '-D') { $view= 'dumper'; }
!     elsif ($arg eq '-ax') { $all= 1; $view= 'extended'; }
!     elsif ($arg eq '--TAB') { $CSV_SEP= "\t"; }
!     elsif ($arg eq '--UTF8') { $UTF8= 1; binmode (STDOUT, ':utf8'); }
!     elsif ($arg =~ /^-t(.+)$/) { $CSV_SEP= $1; $CSV_SEP= 'wiki' if ($CSV_SEP eq 'confluence'); }
!     elsif ($arg =~ /^-T(.+)$/) { $CSV_OUT_SEP= $1; }
!     elsif ($arg =~ /^-B(.*)$/) { &Util::Matrix::set_border_style ($1); }
!     elsif ($arg eq '-') { push (@PAR, $arg); }
!     else { system ("perldoc '$0'"); exit (0); }
    }
    else
--- 87,134 ----
  my $all= 0; # for extend view, sofar...
  
+ sub set_utf8 { $UTF8= 1; binmode (STDOUT, ':utf8'); }
+ sub usage { system ("perldoc '$0'"); exit (0); }
+ 
  my @PAR= ();
  while (defined (my $arg= shift (@ARGV)))
  {
!      if ($arg eq '--') { push (@PAR, @ARGV); @ARGV=(); }
!   elsif ($arg eq '-') { push (@PAR, $arg); }
!   elsif ($arg =~ /^--(.+)/)
    {
!     my ($opt, $val)= split ('=', $1, 2);
! 
!        if ($opt eq 'merge')  { $op_mode= 'merge'; $view= 'no'; }
!     elsif ($opt eq 'dump')   { $DUMP_FILE= shift (@ARGV); }
!     elsif ($opt eq 'out')    { $out_file= shift (@ARGV);  }
!     elsif ($opt eq 'hdr')    { $view= 'header'; }
!     elsif ($opt eq 'json')   { $view= 'json';   }
!     elsif ($opt eq 'dumper') { $view= 'dumper'; }
!     elsif ($opt eq 'setcol') { push (@set_columns,  split (',', $val || shift (@ARGV))); }
!     elsif ($opt eq 'col')    { push (@columns,      split (',', $val || shift (@ARGV))); }
!     elsif ($opt eq 'sort')   { push (@sort_columns, split (',', $val || shift (@ARGV))); }
!     elsif ($opt eq 'num')    { $sort_numeric= 1; }
!     elsif ($opt eq 'TAB')    { $CSV_SEP= "\t"; }
!     elsif ($opt eq 'UTF8')   { set_utf8(); }
!     elsif ($opt eq 'border' || $opt eq 'style') { Util::Matrix::set_border_style ($val); }
!     else { usage(); }
!   }
!   elsif ($arg =~ /^-t(.+)$/) { $CSV_SEP= $1; $CSV_SEP= 'wiki' if ($CSV_SEP eq 'confluence'); }
!   elsif ($arg =~ /^-T(.+)$/) { $CSV_OUT_SEP= $1; }
!   elsif ($arg =~ /^-B(.*)$/) { Util::Matrix::set_border_style ($1); }
!   elsif ($arg =~ /^-(.+)/)
!   {
!     foreach my $opt (split ('', $1))
!     {
!          if ($opt eq 'q') { $strip_quotes= 1; }
!       elsif ($opt eq 'a') { $all= 1; }
!       elsif ($opt eq 'x') { $view= 'extended'; }
!       elsif ($opt eq 'J') { $view= 'json'; }
!       elsif ($opt eq 'D') { $view= 'dumper'; }
!       elsif ($opt eq '8') { set_utf8(); }
!       elsif ($opt eq '9') { $CSV_SEP= "\t"; }
!       elsif ($opt eq '0') { $CSV_SEP= "\0"; }
!       else { usage(); }
!     }
    }
    else
***************
*** 212,216 ****
  {
    print "unknown view mode: [$view]\n";
!   &usage;
  }
  
--- 228,232 ----
  {
    print "unknown view mode: [$view]\n";
!   usage();
  }

[aix-pm-cvs] modules/util/Util Filesystems.pm, 1.2, 1.3 Monitoring.pm, 1.1, 1.2

From: Gerhard G. <go...@us...> - 2014-08-25 16:05:07

Update of /cvsroot/aix-pm/modules/util/Util
In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv28590/modules/util/Util

Modified Files:
	Filesystems.pm Monitoring.pm 
Log Message:
ignore special filesystem types and ignore inodes where not applicable

Index: Filesystems.pm
===================================================================
RCS file: /cvsroot/aix-pm/modules/util/Util/Filesystems.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** Filesystems.pm	6 Aug 2014 15:52:26 -0000	1.2
--- Filesystems.pm	25 Aug 2014 16:05:04 -0000	1.3
***************
*** 27,31 ****
  my %setable= map { $_ => 1 } qw();
  
! my %ignore_fs_type= map { $_ => 1 } qw(none rootfs tmpfs proc devpts devtmpfs usbfs sysfs binfmt_misc);
  my %ignore_fs_path= map { $_ => 1 } qw(tmpfs);
  # print "ignore_fs_type: ", Dumper (\%ignore_fs_type);
--- 27,31 ----
  my %setable= map { $_ => 1 } qw();
  
! my %ignore_fs_type= map { $_ => 1 } qw(none rootfs tmpfs proc devpts devtmpfs usbfs sysfs binfmt_misc fusectl debugfs);
  my %ignore_fs_path= map { $_ => 1 } qw(tmpfs);
  # print "ignore_fs_type: ", Dumper (\%ignore_fs_type);

Index: Monitoring.pm
===================================================================
RCS file: /cvsroot/aix-pm/modules/util/Util/Monitoring.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** Monitoring.pm	13 Aug 2014 10:47:07 -0000	1.1
--- Monitoring.pm	25 Aug 2014 16:05:04 -0000	1.2
***************
*** 19,22 ****
--- 19,23 ----
  
  my @nagios_status= qw(OK UNKNOWN WARNING CRITICAL);
+ my %no_inodes= map { $_ => 1 } qw(cifs);
  
  sub main
***************
*** 210,215 ****
    foreach my $fs (keys %$fs_hash)
    {
      my $x_fs= $fs_hash->{$fs};
!     # print "x_fs: ", Dumper ($x_fs);
  
      # TODO:
--- 211,217 ----
    foreach my $fs (keys %$fs_hash)
    {
+     # print "fs=[$fs]\n";
      my $x_fs= $fs_hash->{$fs};
!     # print "x_fs($fs): ", Dumper ($x_fs);
  
      # TODO:
***************
*** 225,229 ****
--- 227,233 ----
      # TODO: find out if inodes are actually of relevance for this (type of) filesystem
      my $check_inodes= 1;
+     $check_inodes= 0 if (exists ($no_inodes{$x_fs->{'type'}}));
      $check_inodes= 0 if ($ref->{$fs}->{'no_inodes'});
+     # print "check_inodes=[$check_inodes]\n";
      if ($check_inodes)
      {
***************
*** 278,281 ****
--- 282,290 ----
    # these two methods return different values!
    # pct_used2 seems to be the more conservative (higher) value
+   if ($x->{'total'} == 0)
+   {
+     print "ATTN: total==0, x: ", main::Dumper ($x);
+     return 0.0;
+   }
    my $pct_used1=  $x->{'used'} * 100.0 / $x->{'total'};
    my $pct_used2= 100.0 - ($x->{'avail'} * 100.0 / $x->{'total'});

[aix-pm-cvs] modules/util csv.pl,1.34,1.35

From: Gerhard G. <go...@us...> - 2014-08-16 11:10:03

Update of /cvsroot/aix-pm/modules/util
In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv12501

Modified Files:
	csv.pl 
Log Message:
added option to print records in JSON or Data::Dumper format

Index: csv.pl
===================================================================
RCS file: /cvsroot/aix-pm/modules/util/csv.pl,v
retrieving revision 1.34
retrieving revision 1.35
diff -C2 -d -r1.34 -r1.35
*** csv.pl	8 Aug 2014 06:13:18 -0000	1.34
--- csv.pl	16 Aug 2014 11:10:01 -0000	1.35
***************
*** 67,70 ****
--- 67,71 ----
  use Util::Simple_CSV;
  use Util::Matrix;
+ use JSON;
  use Data::Dumper;
  $Data::Dumper::Indent= 1;
***************
*** 83,87 ****
  
  my $strip_quotes= 0;
! my $view= 'matrix'; # or extended, header
  my $all= 0; # for extend view, sofar...
  
--- 84,88 ----
  
  my $strip_quotes= 0;
! my $view= 'matrix'; # values: extended, header, json, dumper
  my $all= 0; # for extend view, sofar...
  
***************
*** 95,98 ****
--- 96,101 ----
      elsif ($arg eq '--out') { $out_file= shift (@ARGV); }
      elsif ($arg eq '--hdr') { $view= 'header'; }
+     elsif ($arg eq '--json') { $view= 'json'; }
+     elsif ($arg eq '--dumper') { $view= 'dumper'; }
      elsif ($arg eq '--setcol') { push (@set_columns, split (',', shift (@ARGV))); }
      elsif ($arg eq '--col') { push (@columns, split (',', shift (@ARGV))); }
***************
*** 102,105 ****
--- 105,110 ----
      elsif ($arg eq '-a') { $all= 1; }
      elsif ($arg eq '-x') { $view= 'extended'; }
+     elsif ($arg eq '-J') { $view= 'json'; }
+     elsif ($arg eq '-D') { $view= 'dumper'; }
      elsif ($arg eq '-ax') { $all= 1; $view= 'extended'; }
      elsif ($arg eq '--TAB') { $CSV_SEP= "\t"; }
***************
*** 190,193 ****
--- 195,208 ----
    $csv->show_header (*STDOUT);
  }
+ elsif ($view eq 'json')
+ {
+   my $json= JSON->new->allow_nonref;
+   my $json_str= $json->pretty->encode ($csv->{'data'});
+   print $json_str;
+ }
+ elsif ($view eq 'dumper')
+ {
+   print Dumper($csv->{'data'});
+ }
  elsif ($view eq 'no')
  {

[aix-pm-cvs] modules/util/Util Monitoring.pm,NONE,1.1

From: Gerhard G. <go...@us...> - 2014-08-13 10:47:09

Update of /cvsroot/aix-pm/modules/util/Util
In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv4304

Added Files:
	Monitoring.pm 
Log Message:
added Util::Monitoring

--- NEW FILE: Monitoring.pm ---
#!/usr/bin/perl
#
# $Id: Monitoring.pm,v 1.1 2014/08/13 10:47:07 gonter Exp $

package Util::Monitoring;

use strict;

use Data::Dumper;

use Util::JSON;
use Util::MongoDB;
use Util::Filesystems;

__PACKAGE__->main() unless caller();

my $ref_inodes= [ 'pct_inodes', 'INODE_LEVEL_WARN' => 90.0, 'INODE_LEVEL_CRIT' => 95.0 ];
my $ref_kbytes= [ 'pct_kbytes', 'KBYTE_LEVEL_WARN' => 90.0, 'KBYTE_LEVEL_CRIT' => 95.0 ];

my @nagios_status= qw(OK UNKNOWN WARNING CRITICAL);

sub main
{
  print join (' ', __FILE__, __LINE__, 'main: caller=['. caller(). ']'), "\n";
}

sub new
{
  my $class= shift;

  my $obj= {};
  bless $obj, $class;

  $obj->set (@_);

  $obj;
}

sub set
{
  my $obj= shift;
  my %par= @_;

  my %res;
  foreach my $par (keys %par)
  {
    $res{$par}= $obj->{$par};
    $obj->{$par}= $par{$par};
  }

  (wantarray) ? %res : \%res;
}

sub get_array
{
  my $obj= shift;
  my @par= @_;

  my @res;
  foreach my $par (@par)
  {
    push (@res, $obj->{$par});
  }

  (wantarray) ? @res : \@res;
}

sub get_hash
{
  my $obj= shift;
  my @par= @_;

  my %res;
  foreach my $par (@par)
  {
    $res{$par}= $obj->{$par};
  }

  (wantarray) ? %res : \%res;
}

*get= *get_array;

sub update_config
{
  my $obj= shift;
  my $cfg_fnm= shift;

  my $do_update= 0;

  if (defined ($cfg_fnm))
  {
    my @st= stat ($cfg_fnm);
    if ($cfg_fnm ne $obj->{'cfg_fnm'}
        # TODO: or file was updated etc. || $
       )
    {
      $do_update= 1;
      $obj->{'cfg_fnm'};
    }
  }

  if ($do_update)
  {
    $obj->read_config($cfg_fnm);
    $obj->setup_ref();
  }

  $do_update;
}

sub read_config
{
  my $obj= shift;
  my $cfg_fnm= shift;

  print "cfg_fnm=[$cfg_fnm]\n";
  my $mon_cfg= Util::JSON::read_json_file($cfg_fnm);
  # print "mon_cfg: ", Dumper ($mon_cfg);

  $obj->{'mon_cfg'}= $mon_cfg;
  $obj->{'cfg_fnm'}= $cfg_fnm;
  # TODO: add mtime for update to work...

    # BEGIN connect to MongoDB collection
    my $paf= $mon_cfg->{'AgentDB'};

    my $n_mon=    setup_default_collection ($paf, 'monitoring');
    my $n_events= setup_default_collection ($paf, 'events');

    print "paf: ", Dumper ($paf);
    print "n_mon=[$n_mon] n_events=[$n_events]\n";

    my ($mdb, $c_moni)= Util::MongoDB::connect ($paf, $n_mon);
    my $c_events= $mdb->get_collection($n_events);
    # print "mdb: ", Dumper ($mdb);
    # print "c_moni: ", Dumper ($c_moni);
    # print "c_events: ", Dumper ($c_events);

    $obj->{'_mdb'}= $mdb;
    $obj->{'_moni'}= $c_moni;
    $obj->{'_events'}= $c_events;
    # END connect to MongoDB collection
  1;
}

=head setup_ref

BEGIN access special settings

=cut

sub setup_ref
{
  my $obj= shift;

  my $ref= $obj->{'_ref'};
  $ref= $obj->{'_ref'}= {} unless (defined ($ref));

  my $fs_list= $obj->{'mon_cfg'}->{'filesystems'};
  
  foreach my $fs (@$fs_list)
  {
    my $mp= $fs->{'mount_point'};
    $ref->{$mp}= $fs;
  }

  print __LINE__, " ref: ", Dumper ($ref);
  $ref;
}

sub setup_default_collection
{
  my $cfg= shift;
  my $name= shift;

# print __LINE__, " cfg: ", Dumper ($cfg);
  my $colls= $cfg->{'collections'};
  $colls= $cfg->{'collections'}= {} unless (defined ($colls));
  my $col= $colls->{$name};
  $col= $colls->{$name}= $name unless (defined ($col));

# print __LINE__, " cfg: ", Dumper ($cfg);
# print "col=[$col]\n";

  $col;
}

=head1 FILE SYSTEM FUNCTIONS

=cut

sub mon_fs
{
  my $mon= shift;

  my ($moni, $events, $ref)= map { $mon->{$_} } qw(_moni _events _ref);

  my $filesystems= new Util::Filesystems ('init' => 1);
  $filesystems->df('k');
  $filesystems->df('i');
  # $filesystems->df('h');
  # print "filesystems: ", Dumper ($filesystems);

  my $worst_status= -1;
  my $worst_msg= 'unknown';

  my $now= time ();
  my $fs_hash= $filesystems->{'fs'};
  foreach my $fs (keys %$fs_hash)
  {
    my $x_fs= $fs_hash->{$fs};
    # print "x_fs: ", Dumper ($x_fs);

    # TODO:
    # * calculate a proper nagios status code
    # * update $worst_status accordingly

    my @cmp= ();

    my $pct_k= get_fs_level($x_fs->{'k'});
    my $res_k= check_level($fs, $pct_k, $ref->{$fs}->{'ref_kbytes'} || $ref_kbytes);
    push (@cmp, $res_k);

    # TODO: find out if inodes are actually of relevance for this (type of) filesystem
    my $check_inodes= 1;
    $check_inodes= 0 if ($ref->{$fs}->{'no_inodes'});
    if ($check_inodes)
    {
      my $pct_i= get_fs_level($x_fs->{'i'});
      my $res_i= check_level($fs, $pct_i, $ref->{$fs}->{'ref_inodes'} || $ref_inodes);
      push (@cmp, $res_i);
    }

    my ($nagios_status, $nagios_msg)= compare_levels(@cmp);
       ($worst_status, $worst_msg)=   compare_levels([$worst_status, $worst_msg], [$nagios_status, $nagios_msg]);

    $moni->update({ 'resource' => $x_fs->{'mp'} },
                  { 'resource' => $x_fs->{'mp'}, 'e' => $now, 'ts' => DateTime->from_epoch('epoch' => $now),
                    'nagios_status'      => $nagios_status[$nagios_status],
                    'nagios_status_code' => $nagios_status,
                    'nagios_msg'         => $nagios_msg,
                    'val' => $x_fs->{'k'}->{'used'},
                    'par' => $x_fs
                  },
                  { 'upsert' => 1 }
                 );
  }

  my $ts= DateTime->from_epoch('epoch' => $now);
  my $ev=
  {
    'event' => 'nagios_update',
    'agent' => 'mon_fs',
    'e' => $now, 'ts' => $ts,
    'worst_status' => $nagios_status[$worst_status],
    'worst_msg' => $worst_msg
  };

  my $event_id= $events->insert($ev);
  print "event_id: ", Dumper ($event_id);

  if (1)
  {
    $ev->{'ts'}= $ts->iso8601();
    $ev->{'_id'}= $event_id->{'value'};
    print "reporing event: ", Dumper ($ev);
    $ev->{'ts'}= $ts;
  }

  $ev;
}

sub get_fs_level
{
  my $x= shift;

  # these two methods return different values!
  # pct_used2 seems to be the more conservative (higher) value
  my $pct_used1=  $x->{'used'} * 100.0 / $x->{'total'};
  my $pct_used2= 100.0 - ($x->{'avail'} * 100.0 / $x->{'total'});

  ($pct_used1 > $pct_used2) ? $pct_used1 : $pct_used2;
}

=head1 GENERIC STATUS FUNCTIONS

=cut

sub compare_levels
{
  my @observations= @_;

# print "compare_levels: observations=", Dumper(\@observations);
  my $highest_level= -1;
  my $highest_msg= 'unknown';
  foreach my $observation (@observations)
  {
    if ($observation->[0] > $highest_level)
    {
      $highest_level= $observation->[0];
      $highest_msg= $observation->[1];
    }
  }
  $highest_level= 1 unless ($highest_level >= 0);

  (wantarray) ? ($highest_level, $highest_msg) : [$highest_level, $highest_msg];
}

sub check_level
{
  my $resource=  shift;
  my $level=     shift;
  my $reference= shift;

  my ($label, $l_warn, $v_warn, $l_crit, $v_crit)= @$reference;

  my ($nagios_status, $nagios_msg);
  if ($level >= $v_crit)
  {
    $nagios_status= 3;
    $nagios_msg= "resource=[$resource] $label=$level >= $l_crit=$v_crit";
  }
  elsif ($level >= $v_warn)
  {
    $nagios_status= 2;
    $nagios_msg= "resource=[$resource] $label=$level >= $l_warn=$v_warn";
  }
  elsif ($level >= 0.0)
  {
    $nagios_status= 0;
    $nagios_msg= "resource=[$resource] $label=$level";
  }
  else
  {
    $nagios_status= 1;
    $nagios_msg= "resource=[$resource] $label=$level";
  }

  (wantarray) ? ($nagios_status, $nagios_msg) : [$nagios_status, $nagios_msg];
}

1;

__END__

=head1 NAME

=head1 SYNOPSIS

=head1 DESCRIPTION

=head1 BUGS

=head1 REFERENCES

=head1 AUTHOR

[aix-pm-cvs] modules/util csv.pl,1.33,1.34

From: Gerhard G. <go...@us...> - 2014-08-08 06:13:20

Update of /cvsroot/aix-pm/modules/util
In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv18396/modules/util

Modified Files:
	csv.pl 
Log Message:
avoid diag output when there is no data at all

Index: csv.pl
===================================================================
RCS file: /cvsroot/aix-pm/modules/util/csv.pl,v
retrieving revision 1.33
retrieving revision 1.34
diff -C2 -d -r1.33 -r1.34
*** csv.pl	26 Mar 2014 10:10:12 -0000	1.33
--- csv.pl	8 Aug 2014 06:13:18 -0000	1.34
***************
*** 156,160 ****
  }
  
! @columns= @{$csv->{'columns'}} unless (@columns);
  
  if (@sort_columns)
--- 156,163 ----
  }
  
! exit (0) unless defined ($csv);
! 
! # print "cols=", Dumper ($csv->{'columns'}), "\n";
! @columns= @{$csv->{'columns'}} if (!@columns && exists ($csv->{'columns'}) && defined ($csv->{'columns'}));
  
  if (@sort_columns)

[aix-pm-cvs] modules/util/Util Filesystems.pm,1.1,1.2

From: Gerhard G. <go...@us...> - 2014-08-06 15:52:28

Update of /cvsroot/aix-pm/modules/util/Util
In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv21163/modules/util/Util

Modified Files:
	Filesystems.pm 
Log Message:
disable diag output

Index: Filesystems.pm
===================================================================
RCS file: /cvsroot/aix-pm/modules/util/Util/Filesystems.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** Filesystems.pm	30 Jul 2014 16:47:21 -0000	1.1
--- Filesystems.pm	6 Aug 2014 15:52:26 -0000	1.2
***************
*** 119,123 ****
    push (@cmd, '-'.$mode);
  
!   print "running [", join (' ', @cmd), "]\n";
    my $now= time ();
    open (DF, '-|', @cmd) or die "can't df";
--- 119,123 ----
    push (@cmd, '-'.$mode);
  
!   # print "running [", join (' ', @cmd), "]\n";
    my $now= time ();
    open (DF, '-|', @cmd) or die "can't df";

[aix-pm-cvs] modules/util/Util Filesystems.pm,NONE,1.1

From: Gerhard G. <go...@us...> - 2014-07-30 16:47:24

Update of /cvsroot/aix-pm/modules/util/Util
In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv9901

Added Files:
	Filesystems.pm 
Log Message:
deal with filesystems on Linux

--- NEW FILE: Filesystems.pm ---

=head1 NAME

  Util::Filesystems

=head1 DESCRIPTION

Wrapper for Linux::Proc::Filesystems and possibly other modules to obtain a full picture about an OS

Wanted information
* mount point info (Sys::Filesystem)
* free space
* LVM

=cut

use strict;

package Util::Filesystems;

use Linux::Proc::Mounts;
use Data::Dumper;
$Data::Dumper::Indent= 1;

my $initialzed= 0;

my %setable= map { $_ => 1 } qw();

my %ignore_fs_type= map { $_ => 1 } qw(none rootfs tmpfs proc devpts devtmpfs usbfs sysfs binfmt_misc);
my %ignore_fs_path= map { $_ => 1 } qw(tmpfs);
# print "ignore_fs_type: ", Dumper (\%ignore_fs_type);

sub new
{
  my $class= shift;

  my $self=
  {
    '_init' => 0,
    'fs' => {},
  };
  bless $self, $class;
  $self->set (@_);

  $self;
}

sub set
{
  my $self= shift;
  my %par= @_;

  my $do_init= 0;
  foreach my $p (keys %par)
  {
    if (exists ($setable{$p})) { $self->{$p}= $par{$p}; }
    elsif ($p eq 'init' && $par{$p}) { $do_init= 1; }
    else { warn("unknown option p=[$p]"); }
  }

  $self->_init(0) if ($do_init);
}

sub _init
{
  my $self= shift;
  my $keep_mp_obj;

  my $m = Linux::Proc::Mounts->read;
  # print "m: ", main::Dumper ($m);

  my %fs; $self->{'fs'}= \%fs;
  my %dev; $self->{'device'}= \%dev;
  my %c_fst; $self->{'c_fst'}= \%c_fst;
  my $count= 0;
  FS: foreach my $mp (@$m)
  {
    my ($fs_spec, $fs_type)= ($mp->spec(), $mp->fstype());
    # print "fs_spec=[$fs_spec] fs_type=[$fs_type] mp: ", main::Dumper ($mp);

    if (exists($ignore_fs_type{$fs_type}))
    {
      # print "ignoring [$fs_type] ", Dumper ($mp);
      next FS;
    }
    else
    {
      my ($fs_file, $opts)= ($mp->file(), $mp->opts_hash());
      # print __LINE__, " XXX: fs_file=[$fs_file] fs_spec=[$fs_spec] fs_type=$fs_type\n";
      my $x= $fs{$fs_file}=
      $dev{$fs_spec}= 
      {
        'mp'   => $fs_file,
        'spec' => $fs_spec,
        'type' => $fs_type,
        'opts' => $opts,
      };
      $x->{'_mp'}= $mp if ($keep_mp_obj);
      # $dev{$fs_spec}= $fs_file;
      $c_fst{$fs_type}++;
      $count++;
    }
  }

  $self->{'_init'}= 1;
  $self->{'_count'}= $count;

  $count;
}

sub df
{
  my $self= shift;
  my $mode= shift;

  my @cmd= ('/bin/df');

  $mode= 'k' unless ($mode =~ /^[ihkm]$/);
  push (@cmd, '-'.$mode);

  print "running [", join (' ', @cmd), "]\n";
  my $now= time ();
  open (DF, '-|', @cmd) or die "can't df";
  my @headings;
  my $c= 0;
  my @lines= ();
  DF: while (<DF>)
  {
    chop;
    # print __LINE__, " df: [$_]\n";
    if ($c++ == 0)
    {
      @headings= split (' ', $_, 6);
      next DF;
    }

    if ($_ =~ /^ /) { $lines[$#lines] .= $_; }
    else { push (@lines, $_); }
  }

  # print "headings: ", Dumper (\@headings);
  # print "lines: ", Dumper (\@lines);

  foreach my $l (@lines)
  {
    my ($dev, $total, $used, $avail, $pct, $mp)= split (' ', $l, 6);
    my $x= $self->{'device'}->{$dev};
    $x->{$mode}=
    { 
      'e' => $now,
      'total' => $total,
      'used' => $used,
      'avail' => $avail,
      'pct' => $pct,
    };
  }

}


1;
__END__

Flat | Threaded

<< < 1 2 3 4 5 .. 24 > >> (Page 3 of 24)