Perl

от ILuxWiki

Съдържание 1 Интересни адреси 2 Сортиране 3 Скриптове 3.1 Вкарване на запетайки в големи числа 3.2 Проверка на свободното място 3.3 Следене текущия трафик на мрежовите устройства 3.4 Управление на mpd демона 3.5 Работа с IPFW

Интересни адреси

1. http://www.akadia.com/services/perl_important.html - DBI, CGI scripts and Tips
2. http://www.perl.com/pub/a/2004/06/10/email.html - The Evolution of Perl Email Handling
3. http://search.cpan.org/dist/Class-DBI/lib/Class/DBI.pm - Нещо което трябва да се науча да прилагам.

Сортиране

1. Документ за сортиране на всякакъв вид структури в Perl.
2. Сортиране на ip-та:

print MPD mpd_conf(sort sort_ip @users);
sub sort_ip {
   pack('C4' => $a->{ip} =~ /(\d+)\.(\d+)\.(\d+)\.(\d+)/)
   cmp
   pack('C4' => $b->{ip} =~ /(\d+)\.(\d+)\.(\d+)\.(\d+)/)
}

Скриптове

Вкарване на запетайки в големи числа

#!/usr/bin/perl

# Putting Commas in Numbers

sub commify {
    my $text = reverse $_[0];
    $text =~ s/(\d\d\d)(?=\d)(?!\d*\.)/$1,/g;
    return scalar reverse $text;
}

$hits = 39586765342;
$output = "Your web page received $hits accesses last month.\n";
print commify($output);

==> Output: Your web page received 39,586,765,342 accesses 
    last month.

Проверка на свободното място

check_df - проверка на свободното място с изпращане на емайл с известяване на root@localhost

 #!/usr/bin/perl
 # check_df  by Todor Dragnev
 # crontab lines:
 # */30 9-18 * * * /g00net/bin/check_df
 $alert_on = 99; # in percent

 #skip device example 
 # $skipdev="hdb|hda1|hda5";

 @df = `/bin/df -x none |/usr/bin/egrep -v "$skipdev"`;
 
 for (@df) 
 {
   next if /^File/;
   chomp;
   ($dev,$blocks,$used,$avail,$capacity,$mountpoint) = /(.*?)\s*(\d*?)\s*(\d*?)\s*(\d*?)\s*(\d*)%\s*(\/.*)/g;
   if ($capacity > $alert_on) 
   {
     system ("/bin/df -t ext3|/bin/mail root -s '*** Low space in $dev ***'")
   }
 };

Следене текущия трафик на мрежовите устройства

ethertraf - наблюдаване количеството трафик на всяко едно мрежово устрйство в текущия момент

#!/usr/bin/perl
#/g00net/bin/ethertraf
# Dragomir Zhelev <drago@g00net.org>
use strict;
my ($dev,$rx,$tx );
my (%sino, %sin, %soto, %sot, %sumi, %sumo );
my ($sumi, $sumo);
while ( ) {
   open ( ND , "/proc/net/dev" ) || die "Error $!";
   print "\x1b\x5b\x48\x1b\x5b\x32\x4a";
    
   while (<ND>) {
       next if /^Inter|^ face/;
       s/^ +//;
       ($dev,$rx,$tx) = (split /: *|\s+/)[0,9,1];
       next if ($rx == 0);
  
       $sin{$dev} = $rx;
       $sot{$dev} = $tx;
   }
       print "Device:          speed out:      speed in: \n";
       print "=" x 43,"\n";
  
      for (sort keys %sin) {
        printf ("%-12s %10.2f k/s %10.2f k/s \|\n",$_,(($sin{$_}-$sino{$_})/1024),(($sot{$_}-$soto{$_})/1024));
        $sumi += ($sin{$_}-$sino{$_});
        $sumo += ($sot{$_}-$soto{$_});
       }
  print "=" x 43,"\n";
  printf ("TOTAL:       %10.2f k/s %10.2f k/s\n", ($sumi/1024), ($sumo/1024));
  %sino=%sin;
  %soto=%sot;
  $sumi=$sumo=0;
  sleep 1;
}

Управление на mpd демона

bash-2.05# more kill.pl

#!/usr/bin/perl -w

if( $ARGV[3] eq  ) { die 'Usage: kill.pl user nasip userip nasport'; };

$user=$ARGV[0];
$nasip=$ARGV[1];
$userip=$ARGV[2];
$nasport=$ARGV[3];
$nastelnetport=5005;

use IO;

$sock = IO::Socket::INET->new(
PeerAddr => $nasip,
PeerPort => $nastelnetport,
Proto => 'tcp') or die "Can not connect to mpd!\n$!";
$sock->autoflush(1);

print $sock "link pptp",$nasport,"\n"; 
print $sock "show radius\n"; 
print $sock "close\n";
close $sock;
exit 0;

Работа с IPFW

Програмче от сървъра на Златко

#!/usr/bin/perl
# vim: syntax=perl ts=4 sw=4
# by todor at linuxfan.org

$file = '/root/cfg/users';
$base_speed = 250;      # KBytes/s
$base_speed_out = 64; # KBytes/s
$acc_pipe = 100;
$base_pipe = 100;
$base_pipe_out = 200;

open (FI, $file);

@users = <FI>;

$count = scalar @users;
$line = 0;
for (@users) {
       $line++;
       next if /^$|^#/;
       chomp;
       if ( /((\d+\.){3}\d+)\s+(\d+)/ ) {
               $ip = $1;
               $percent = $3;
               $acc = $acc_pipe + $line;
               $pipe = $base_pipe + $line;
               $pipe_out = $base_pipe_out + $line;
               $speed = int ($base_speed * ( $percent / 100 ) * 8  );
               $speed_out = int ($base_speed_out * ( $percent / 100 ) * 8 );
               print "$ip, $percent%, $speed KBit/s\n";
               push @rules, "\n# ip: $ip";
               push @rules, "/sbin/ipfw -q add $acc count all from $ip to any in via net1";
               push @rules, "/sbin/ipfw -q add $acc count all from any to $ip out via net1";
               push @rules, "/sbin/ipfw -q pipe $pipe config bw $speed" . "Kbit/s";
               push @rules, "/sbin/ipfw -q pipe $pipe_out config bw $speed_out" . "Kbit/s";
               push @rules, "/sbin/ipfw -q add allow tcp from any 5190 to $ip";
               push @rules, "/sbin/ipfw -q add allow tcp from $ip to any 5190";
               push @rules, "/sbin/ipfw -q add pipe $pipe ip from any to $ip via net1";
               push @rules, "/sbin/ipfw -q add pipe $pipe_out ip from $ip to any via net1";
       } else {
               print STDERR "ERROR: Bad entry in line[$line]: $_\n";
       }
}

for (@rules) {
       system($_);
}