Mes scripts Perl qui peuvent servir d'exercices

From Deimos.fr / Bloc Notes Informatique
Jump to: navigation, search

1 Introduction

C'est pas toujours simple de commencer un langage de programmation, surtout quand on en a jamais fait à l'école ! C'est pourquoi je vous propose des petits scripts que j'ai fais juste après m'être tapé des bouquins. Les scripts devraient donc aller plus ou moins crescendo niveau difficulté.

2 PS, Java et XMX

Pour le boulot, je devais créer un script sous Solaris listant les users, pid, date de lancement des java et quelques autres informations. Le but était de montrer les XMX utilisés sans toute la commande java insérée, ni d'autres informations inutiles pour les personnes qui allaient utiliser ce script. Voici donc mon premier script perl :

Configuration File 
#!/usr/bin/perl -w
## Java Status Script for Solaris ##
## Made by Pierre Mavro ##
 
use strict;
 
my $line;
my $ups;
 
print "\n############## Bridge Status ##############\n\n";
print "  USER\t   PID\t\%MEM   TIME  XMX\n";
 
open FILE, "ps -edfo user,pid,pmem,stime,args \| grep java \| grep -v grep |";
 
while ($line = <FILE>){
        if ($line =~ /^(.*[_|:]\d+).*/) {
                $ups = $1; 
                if ($line =~ /.*-Xmx(\d+)/) {
                        print "$ups $1M\n";
                } else {
                        print "$ups NO XMX DEFINED\n";
                }
        }
}
 
close FILE;
print "\n"

3 Création d'utilisateur pour comptes SFTP

Ce script a été conçu pour créer et supprimer un compte utilisateur SFTP. Ensuite il envoie un mail à l'admin, et en copie la personne concernée. Il y a également une génération automatique de mot de passe.

Configuration File 
#!/usr/bin/perl -w
## SFTP Mangament Script ##
## Made by Pierre Mavro ##
 
## Needed componants
# - apg
# - Perl "Mail::Sender::Easy" module
 
use strict;
 
# Load Modules
use Mail::Sender::Easy qw(email);
 
die "USAGE: manage_sftp_user.pl [create|delete] username login(\@mycompany.com of the consultant mail)\n" if ($ARGV[0] !~ /(create|delete|remove)/);
 
my $create_account;
my $gen_pass;
my $crypted_pass;
my $user_login = $ARGV[1];
my $mail_cc = $ARGV[2];
 
# Functions
# User deletion
sub user_del {
    if ($ARGV[0] eq "delete") {
        system "sftp-kill", $user_login;
        system "userdel", "-r", $user_login;
        system "rm", "-Rf", "/home/clients/$user_login";
    }   
}
 
# User creation
sub user_add {
    if ($ARGV[0] eq "create") {
        # Generating password
        $gen_pass = `apg -a0 -n1 -x10 -m10 -MCN`;
        chomp $gen_pass;
        # Encrypt for useradd
        $crypted_pass = `encrypt $gen_pass`;
        chomp $crypted_pass;
        $create_account = `useradd -mg 1000 -k /etc/skel -s /bin/MySecureShell -d /home/clients/$user_login -p '$crypted_pass' $user_login`;
        # Add .htaccess file
        open HTFILEW, ">/home/clients/$user_login/.htaccess" or die "Can't create /home/clients/$user_login/.htacess file, please erase account : $!";
        my $htaccess = <<"HTEND";
AuthType Basic
AuthName "Mycompany Secure Access"
Require user $user_login
Satisfy all
HTEND
        print HTFILEW $htaccess;
        close HTFILEW;
        # Set good rights
        chmod 0575, "/home/clients/$user_login";
        chmod 0575, "/home/clients/$user_login/download";
        chmod 0777, "/home/clients/$user_login/upload";
        chmod 0400, "/home/clients/$user_login/.htaccess";
        chown 67, 1000, "/home/clients/$user_login/.htaccess";
        # Removing some unwanted files
        system "rm", "-f", "/home/clients/$user_login/.profile";
        system "rm", "-f", "/home/clients/$user_login/.login";
    }   
}
 
sub send_mail {
    # Just a verification to be sure that the username folder has been created
    if ( -d "/home/clients/$user_login" ) { 
        email({
            'from'         => 'it-system@mycompany.com',
            'to'           => 'it-system@mycompany.com',
            'cc'           => "$mail_cc\@mycompany.com",
            'subject'      => "New SFTP Account for $user_login",
            'priority'     => 2,
            'confirm'      => '', 
            'smtp'         => 'localhost',
            'port'         => '25',
            'auth'         => '',
            'authid'       => '',
            'authpwd'      => '',
            '_text'        => '',
            '_html'        => "Informations on configuration of an SFTP Client to connect to mycompany SFTP Server :<br /><br />
                               Host address : sftp.mycompany.com<br />
                               Port : 22<br />
                               Login : $user_login<br />
                               Password : $gen_pass<br /><br />
                               If you are on windows, we recommand this client : <a href=\"http://winscp.net\">WinSCP</a><br /><br />
                               Those informations are confidentials, please keep them safetly.",
        }) or die "email() failed: $@";
    }
}
 
# Launch
die "USAGE: manage_sftp_user.pl [create|delete] username login(\@mycompany.com of the consultant mail)\n" if ((@ARGV > "3") or (@ARGV < "2"));
 
if ($ARGV[0] eq "delete") {
    &user_del;
} elsif ($ARGV[0] eq "create") {
    die "USAGE: manage_sftp_user.pl [create|delete] username login(\@mycompany.com of the consultant mail)\n" if (@ARGV ne "3");
    &user_add;
    &send_mail;
}

4 Contrôler le nombre d'utilisateurs pour MySecureShell

Etant un des fondateurs de MySecureShell, j'ai du créer des scripts pour les agents Nagios. Voici donc un script permettant de monitorer le nombre de users par rapport au maximum :

Configuration File check_mss_users 
#!/usr/bin/perl -w
#
# Usage : check_mss_users ([warn] [critical] are optionals)
#
# Nagios script to check MySecureShell users (can be checked only on MySecureShell server)
#
# Made by Pierre Mavro / MySecureShell Team
 
use strict;
 
#### Vars can be touched ####
my $sftp_who = "/usr/bin/sftp-who"; # sftp-who binary
 
#### Do not edit now ####
my $warn_mss_users = $ARGV[0] or 0.75; # warning MySecureShell users or using 75% by default
my $crit_mss_users = $ARGV[1] or 0.90; # critical MySecureShell users or using 90% by default
my $max_mss_users;
my $curr_mss_users;
 
sub get_infos {
        # Check config file and read config file to check LimitConnection value
        open (SFTP_WHO, "$sftp_who |") or die "Couldn't execute $sftp_who binary : $!\n";
        while (my $line = <SFTP_WHO>) {
                # Find the currently and maximum connected users
                if ($line =~ /^---.(\d+).\/.(\d+).clients/) {
                        $curr_mss_users = $1; 
                        $max_mss_users = $2; 
                }
        }
        close SFTP_WHO;
}
 
sub check {
        if ($curr_mss_users < $warn_mss_users) {
                print "USERS OK - currently connected $curr_mss_users / $max_mss_users |users=$curr_mss_users;$warn_mss_users;$crit_mss_users\n";
                exit(0);
        } elsif ($curr_mss_users < $crit_mss_users) {
                print "USERS WARNING - currently connected $curr_mss_users / $max_mss_users\n";
                exit(1);
        } else {
                print "USERS CRITICAL - currently connected $curr_mss_users / $max_mss_users\n";
                exit(2);
        }
}
 
# If the twice values are defined
if ((defined($warn_mss_users)) and (defined($crit_mss_users))) {
        &get_infos;
        &check;
# If only one value is defined
} elsif ((defined($warn_mss_users)) or (defined($crit_mss_users))) {
        print "Usage : check_mss_users ([warn] [critical] are optionals)\n";
        exit(-1);
# If no values are defined, defaults are used
} else {
        &get_infos;
        &check;
}

5 Gestion de comptes Freeradius

Voici un script qui permet de gérer (ajouter/supprimer) des comptes radius. De plus il permet de changer les mots de passe. De rappeller que le mot de passe va changer par mail et de renvoyer les identifiants pour les personnes tête en l'air.

On va pouvoir également lister les personnes avec leurs identifiants dans un beau tableau ainsi que répliquer aux serveurs radius secondaires via ssh.

Pour que Radius fonctionne ensuite correctement, il va falloir ajouter ceci dans /etc/freeradius/users :

Configuration File /etc/freeradius/users 
 $INCLUDE  vpn_users

Pour l'utilisation de ce script, il va falloir dans la crontab ajouter le script avec :

  • generate : pour générer de nouveaux mots de passe dans un nouveau fichier et envoyer un mail à chaque utilisateurs
  • reminder : pour rappeller aux utilisateurs que leur mot de passe va changer
  • switch : pour utiliser le nouveau fichier avec les nouveaux identifiants
Configuration File vpn_user_management.pl 
#!/usr/bin/perl -w
## VPN Users Management v0.3 ##
## Made by Pierre Mavro ##
 
## DEPENDANCIES ##
# For this working script, you need :
# - apg command
# - File::Copy perl module
# - Mail::Sender perl module
# - Net::SSH perl module
# - Net::SCP perl module
 
use strict;
 
# Load Modules
use File::Copy;
use Mail::Sender;
use Net::SSH qw(ssh);
use Net::SCP qw(scp);
 
# Verify syntax
unless ($ARGV[0]) {
    &help;
}
 
## Vars ##
my $apg_exec = "/usr/bin/apg"; # APG executable location
my $radius_user_file = "/etc/freeradius/vpn_users"; # Radius users file
my $radius_user_file_bak = "/etc/freeradius/vpn_users_bak"; # Radius backup user file
my $radius_user_file_new = "/etc/freeradius/vpn_users_new"; # Radius new users temp file
my $radius_user_file_tmp = "/etc/freeradius/vpn_users_tmp"; # Radius users file
my @all_existing_radius_users; # Get all radius users files
my $mail_fqdn = "myconpany.com"; # Will be use for your company fqdn mail
my @radius_nodes = qw(tasmania); # Radius server node list (must have ssh keys)
 
# Do not touch
my @tab_users_unsorted;
my @tab_users;
my @tab_pass;
my $user;
my $password;
my $number_of_users;
my $user_pass_id;
my $scp;
my $node;
my $radius_user_files;
 
# Add the new radius user file to array to upgrade new file too
$all_existing_radius_users[0] = $radius_user_file;
if (-f $radius_user_file_new) {
    push @all_existing_radius_users, $radius_user_file_new;
}
 
## Testing dependancies ##
die "Sorry but APG could not be found, please install it or change the location (actually : $apg_exec)\n" if (! -f $apg_exec);
 
## Functions ##
 
# Help
sub help {
    print "USAGE: vpn_user_management.pl [list|create|delete|generate|switch|reminder|send|replicate|help] [user_login]\n";
    print "\t- list : list all users with their password\n";
    print "\t- create : create user (eg. vpn_user_management.pl create username)\n";
    print "\t- delete : delete user (eg. vpn_user_management.pl delete username)\n";
    print "\t- reminder : resend new credentials by mail (eg. vpn_user_management.pl reminder (WARNING, this will send to all users))\n";
    print "\t- generate : generate a file with new passwords and send them by mail (eg. vpn_user_management.pl generate)\n";
    print "\t- switch : switch to new credentials (new to last generated credentials file)\n";
    print "\t- send : send credentials to one user or all users (eg. vpn_user_management.pl send [username|all])\n";
    print "\t- replicate : replicate the configuration to other nodes and restart (eg. vpn_user_management.pl replicate)\n";
    print "\t- help : print this page\n";
    exit (1);
}
 
# Count and stock current usernames
sub count_stock_users {
    open (FILER, "<$radius_user_file") || die("Can't open file : $!");
	while (<FILER>) {
		if ($_ =~ /^(\w+).+Auth-Type.+".+"/) {
			push @tab_users_unsorted, $1;
		}
	}
    # Sort by name
    @tab_users = sort (@tab_users_unsorted);
    $number_of_users = @tab_users;
    close (FILER);
}
 
# Generate passwords for clients
sub genpass {
    $user_pass_id = 0;
    # Gen passwords
    my @passwords = `$apg_exec -a0 -n$number_of_users -x10 -m10 -MCN`;
    chomp @passwords;
    # Push to tab
    foreach $user (@passwords) {
        push @tab_pass, $user;
        $user_pass_id++;
    }
}
 
# Generate a new file with new credentials
sub gen_file {
    open (FILER, "<$radius_user_file") || die("Can't open file : $!");
    open (FILEW, ">$radius_user_file_new") || die("Can't write file : $!");
    $user_pass_id = 0;
    # Write users and pass to file
    foreach $user (@tab_users) {
        printf FILEW "%-15s", "$tab_users[$user_pass_id]";
        print FILEW "\t\tAuth-Type := Local, User-Password == \"$tab_pass[$user_pass_id]\"\n";
		print FILEW "\t\t\tFilter-Id = \"vpnhome\"\n\n";
        &send_mail;
        $user_pass_id++;
    }
    # Write the rest
	while (<FILER>) {
	    if ($_ =~ /^#|DEFAULT.+|Fall-Through.+|Framed-.+/) {
			print FILEW $_;
		}
	}
    close (FILEW);
    close (FILER);
}
 
# Create user
sub create_user {
    if ($ARGV[1]) {
        # Check if user exist
        foreach $radius_user_files (@all_existing_radius_users) {
            open (FILER, "<$radius_user_files") || die("Can't open file : $!");
                while (<FILER>) {
                if ($_ =~ /^(\w+).+Auth-Type.+".+"/) {
                    if ($1 eq $ARGV[1]) {
                      die("Sorry but user already exist\n");
                    }
                }
            }
            close (FILER);
            # Generate password
            $password = `$apg_exec -a0 -n1 -x10 -m10 -MCN`;
            chomp $password;
            # Write to raddius files
            open (FILEW, ">>$radius_user_files") || die("Can't write file : $!");
            printf FILEW "%-15s", "$ARGV[1]";
            print FILEW "\t\tAuth-Type := Local, User-Password == \"$password\"\n";
            print FILEW "\t\t\tFilter-Id = \"vpnhome\"\n\n";
            close (FILEW);
            # Push to arrays for sending mails
            $user_pass_id = 0;
            push @tab_users, $ARGV[1];
            push @tab_pass, $password;
        }
    } else {
        &help;
    }
}
 
sub listing {
    $number_of_users = 0;
    open (FILER, "<$radius_user_file") || die("Can't open file : $!");
    # Create ASCII array
    print " ", "_" x 36, "\n", "|", " " x 7, "Users", " " x 7, "|", " " x 3, "Passwords", " " x 4, "|", "\n", "|", "_" x 19, "|", "_" x 16, "|", "\n";
    while (<FILER>) {
        # Print users and passwords
        if ($_ =~ /^(\w+).+Auth-Type.+"(.+)"/) {
            printf "%-20s", "| $1";
            print "| $2     |\n";
            $number_of_users++;
        }
    }
    # Print the end of the array
    print "|", "_" x 19, "|", "_" x 16, "|", "\n";
    print "\nThere is a total of $number_of_users VPN users\n\n";
    close (FILER);
}
 
sub delete_user {
    if ($ARGV[1]) {
        foreach $radius_user_files (@all_existing_radius_users) {
            my $user_delete = 0;
            open (FILER, "<$radius_user_files") || die("Can't open file : $!");
            open (FILEW, ">$radius_user_file_tmp") || die("Can't write file : $!");
            my $founded_user = 0;
            while (<FILER>) {
                if ($_ =~ /^#|DEFAULT.+|Fall-Through.+|Framed-.+/) {
                    print FILEW $_;
                } elsif ($founded_user == 1) {
                    if ($_ =~ "Filter-Id = \"vpnhome\"") {
                        $founded_user = 0;
                       }
                } elsif ($founded_user == 0) {
                    if ($_ =~ /(\w+).+Auth-Type.+".+"/) {
                        if ($1 eq $ARGV[1]) {
                            $founded_user = 1;
                            $user_delete = 1;
                        } else {
                            # Write if not the requiered user
                            print FILEW "$_";
                            print FILEW "\t\t\tFilter-Id = \"vpnhome\"\n\n";
                        }
                    }
                } else {
                    print FILEW $_;
                }
            }
            close (FILEW);
            close (FILER);
            if ($user_delete == 1) {
                print "User $ARGV[1] has been deleted on $radius_user_files file\n";
            } else {
                print "User $ARGV[1] has not been deleted because he hasn't been found on $radius_user_files file\n";
            }
            move("$radius_user_file_tmp","$radius_user_files");
        }
    } else {
        &help;
        exit (1);
    }
}
 
sub send_mail {
        # Login send
        eval {
                (new Mail::Sender)
                ->OpenMultipart({
                        smtp => 'localhost',
                        from => "admins\@$mail_fqdn",
                        to => "$tab_users[$user_pass_id]\@$mail_fqdn",
                        subject => 'myconpany VPN Credentials',
                        multipart => 'mixed',
                })
                        ->Part({ctype => 'text/html', disposition => 'NONE', msg => <<END})
<html><body>
Here is your new VPN credentials.<br /><br />
<b>They will take effect the 7th of the month</b> at 3:00 AM (Paris Time)<br /><br />
Login : <b>$tab_users[$user_pass_id]</b><br />
Password : <b>For security reasons it will be sent in another mail</b><br />
IP Address : <b>x.x.x.x</b><br />
Group ID: <b>myconpany</b><br />
Group Password : <b>myconpany_pass</b><br /><br />
You can download Cisco VPN Client on "S\:\\\\Software\\VPN client\\WIN\".<br /><br />
<b>Those informations are confidentials, please keep them safetly.</b>"
</body></html>
END
                        ->EndPart("multipart/alternative")
                ->Close();
 
                (new Mail::Sender)
                ->OpenMultipart({
                        smtp => 'localhost',
                        from => "admins\@$mail_fqdn",
                        to => "$tab_users[$user_pass_id]\@$mail_fqdn",
                        subject => 'myconpany VPN Credentials',
                        multipart => 'mixed',
                })
                        ->Part({ctype => 'text/html', disposition => 'NONE', msg => <<END})
<html><body>
Your new VPN password is : <b>$tab_pass[$user_pass_id]</b><br /><br />
<b>Those informations are confidentials, please keep them safetly.</b>
</body></html>
END
                        ->EndPart("multipart/alternative")
                ->Close();
        } or print "Error sending mail: $Mail::Sender::Error\n";
}
 
sub send_users {
    if ($ARGV[1]) {
        $user_pass_id = 0;
        @tab_users = ();
        open (FILER, "<$radius_user_file") || die("Can't open file : $!");
        # If all, send credentials to everybody
        if ($ARGV[1] eq "all") {
            	while (<FILER>) {
            		if ($_ =~ /^(\w+).+Auth-Type.+"(.+)"/) {
            			push @tab_users, $1;
                        push @tab_pass, $2;
                        &send_mail;
                        $user_pass_id++;
            		}
            	}
        } else {
            # else only one user
          	while (<FILER>) {
                if ($_ =~ /^(\w+).+Auth-Type.+"(.+)"/) {
                    if ($1 eq $ARGV[1]) {
           			    push @tab_users, $1;
                        push @tab_pass, $2;
                        &send_mail;
                    }
                }
            }
        }
        close (FILER);
    } else {
        &help;
    }
}
 
sub remind_users {
        $user_pass_id = 0;
        @tab_users = ();
        open (FILER, "<$radius_user_file") || die("Can't open file : $!");
       	while (<FILER>) {
            if ($_ =~ /^(\w+).+Auth-Type.+".+"/) {
                eval {
                    (new Mail::Sender)
                    ->OpenMultipart({
                            smtp => 'localhost',
                            from => "admins\@$mail_fqdn",
                            to => "$1\@$mail_fqdn",
                            subject => '2 Days before VPN password changing',
                            multipart => 'mixed',
                    })
                            ->Part({ctype => 'text/html', disposition => 'NONE', msg => <<END})
<html><body>
<b>Remember your VPN is about to change in 2 days.</b>
<br /><br />
Your new credentials sent in a previous mail will take effect.
</body></html>
END
                    ->EndPart("multipart/alternative")
                ->Close();
            } or print "Error sending mail: $Mail::Sender::Error\n";
        }
    }
}
 
sub syncro_nodes {
    system "/etc/init.d/freeradius", "restart";
    foreach $node (@radius_nodes) {
        # Transfer files
        $scp = Net::SCP->new("$node", "root");
        # Choose remote directory
        $scp->cwd("/etc/freeradius") or die $scp->{errstr};
        # Upload file
        $scp->put("$radius_user_file") or die $scp->{errstr};
        # Restart SSH
        ssh("root\@$node", "/etc/init.d/freeradius", "restart");
    }
}
 
## Starting
 
# Starting first arg check
if ($ARGV[0] eq "generate") {
    &count_stock_users;
    &genpass;
    &gen_file;
} elsif ($ARGV[0] eq "list") {
    &listing;
} elsif ($ARGV[0] eq "switch") {
    move("$radius_user_file_new","$radius_user_file");
    &syncro_nodes;
} elsif ($ARGV[0] eq "create") {
    &create_user;
    &send_mail;
    &syncro_nodes;
} elsif ($ARGV[0] eq "delete") {
    &delete_user;
    &syncro_nodes;
} elsif ($ARGV[0] eq "replicate") {
    &syncro_nodes;
} elsif ($ARGV[0] eq "send") {
    &send_users;
} elsif ($ARGV[0] eq "reminder") {
    &remind_users;
} else {
    &help;
}
 
__END__

6 Logs GC Analyzer

Voici un petit script qui permet de surveiller les logs gc ainsi que d'être prévenu après un certain pourcentage de dépassement. Il prévient également si un Full GC a lieu :

Configuration File gc_analyzer.pl 
#!/usr/bin/perl -w
## GC Analyzer tool v0.1 ##
## Made by Pierre Mavro ##
 
## DEPENDANCIES ##
# To make this script working, you need :
# - Mail::Sender perl module
 
use strict;
use Mail::Sender;
 
## Vars ##
# Global vars
my $product="Confluence"; # Give the product name
 
# Mails parameters
my $mail_smtp_server="localhost"; # Set the ip or mail name server
my $mail_user_from="admin"; # Set the mail sender name
my $mail_user_to="admin"; # Set the mail receiver name
my $mail_fqdn="company.com"; # Set the FQDN for incomming mails (eg. user@
 
# Others vars
my $log_gc_file=$ARGV[0];
my $percent_gc_warn=$ARGV[1];
my $total_curr_gc;
my $percent_gc;
my $mail_subject;
my $problem_line;
my $mail_status;
my $curpos;
 
# Verifications
&help if (@ARGV < 2);
 
### Starting Analyze ###
 
## Funtions ##
 
# Help
sub help {
    print "USAGE: gc_analyzer.pl [LOG GC File] [Percent for warning]\n";
    print "\t- eg: gc_analyzer.pl /home/pmavro/loggc 20\n";
    print "\t- help : print this page\n";
    exit (1);
}
 
# Send mail
sub send_mail {
    if ($mail_status eq "warning") {
        $mail_subject="WARNING ($product) : $percent_gc_warn% of GC memory has been reached !";
    } elsif ($mail_status eq "critical") {
        $mail_subject="CRITICAL ($product) : A Full has proceed";
    }
        eval {
                (new Mail::Sender)
                ->OpenMultipart({
                        smtp => "$mail_smtp_server",
                        from => "$mail_user_from\@$mail_fqdn",
                        to => "$mail_user_to\@$mail_fqdn",
                        subject => "$mail_subject",
                        multipart => 'mixed',
                })
                        ->Part({ctype => 'text/html', disposition => 'NONE', msg => <<END})
<html><body>
This line has been extracted from LOG GC file ($log_gc_file) on $product product :<br /><br />
$problem_line
</body></html>
END
                        ->EndPart("multipart/alternative")
                ->Close();
        } or print "Error sending mail: $Mail::Sender::Error\n";
}
 
open GCFILE, "<$log_gc_file" or die "Sorry but the file wasn't found\n : $!";
 
# Watchdog on the file
seek(GCFILE, 0, 1);
for (;;) {
    for ($curpos = tell(GCFILE); <GCFILE>; $curpos = tell(GCFILE)) {
        chomp $_;
        $problem_line=$_;
        # If a Full GC is detected
        if ($_ =~ /.*Full GC.*/) {
            $mail_status="critical";
            &send_mail;
        # If GC, percentage should be calculated
        } elsif ($_ =~ /.+\[GC (\d+)K->(\d+)K\((\d+)K\).+/) {
            # Prepare for calcul
            $total_curr_gc=$2;
            $percent_gc=($3*$percent_gc_warn)/100;
            # Check the percentage before Full GC
            if ($total_curr_gc ge $percent_gc) {
                $mail_status="warning";
                &send_mail;
            }
        } else {
            print "Unknow line : $_\n";
        }
    }
    sleep(1);
    seek(GCFILE, $curpos, 0);
}
 
close ($log_gc_file);

7 Multithreader un hash MD5

Voilà un exemple simple qui peut servir de base à un script multi threadé. Il calcule le hash md5 d'une liste de fichiers, ce qui est plutôt con, mais c'est à vous d'imaginer le traitement à effectuer.

Ce qui est intéressant, c'est :

  • Le lancement des threads
  • Les threads qui lockent le tableau, en enlèvent un élément, puis le libèrent
  • L'arrêt des threads
Configuration File gc_analyzer.pl 
#!/usr/bin/perl
 
use strict;
use warnings;
use threads;
use threads::shared;
use Digest::MD5;
 
our $VERSION = 1.0;
our $SLASH = q{/};
 
# Getting command line arguments
my @arguments = @ARGV;
if (!$arguments[0])
{
    usage ();
}
my $directory = $arguments[0];
my $max_threads = 2;
if ($arguments[1] && $arguments[1] =~ /^\d{1,2}$/xm)
{
    $max_threads = $arguments[1];
}
 
# Getting regular files in the directory
my $DIR;
opendir $DIR , $directory or die "unable to opendir: $!\n";
my @files = grep { -f "$directory/$_" } readdir $DIR or die "unable to readdir: $!\n";
closedir $DIR or die "unable to closedir: $!\n";
my @tableau : shared = sort @files;
 
# Launching threads
my @threads;
for (1 .. $max_threads)
{
    my $thread = threads->create ('thread_code');
    push @threads , $thread;
}
 
# Waiting for the threads to finish
while (@threads)
{
    my $thread = shift @threads;
    $thread->join ();
}
print "fini\n" or die "unable to print: $!\n";
exit 0;
 
 
##################################
 
 
sub thread_code
{
    BOUCLE : while (1)
    {
	my $element;
	{
	    # In this block, we only manage the shared array
	    # We don't want it to be locked for too long
	    lock @tableau;
	    $element = shift @tableau;
	    if (!$element)
	    {
		last BOUCLE;
	    }
	    if ($element =~ /^\.{1,2}$/xm)
	    {
		next BOUCLE;
	    }
	}
 
	# We calculate the md5sum of the file, and we display it
	my $ctx = Digest::MD5->new;
	my $FILE;
	open $FILE , '<' , $directory.$SLASH.$element or next BOUCLE;
	$ctx->addfile ($FILE);
	close $FILE or next BOUCLE;
	my $digest = $ctx->hexdigest;
	print threads->self->tid () . " : $element -> $digest\n" or next BOUCLE;
    }
    return;
}
 
sub usage
{
    print <<"EOM" or die "unable to print: $!\n";
Usage: $0 directory [max_threads]
\tdirectory: the directory you want to scan.
\tmax_threads: the maximum number of threads you vant to run (1 .. 99). Defaults to 2.
EOM
    exit 1;
}

Merci à l'équipe GCU Squad pour ce script

8 Script Cluster SUN pour applications Java

Pour mon boulot, j'ai eu besoin de créer ce genre de script. Je ne vais pas rentrer dans les détails, mais il gère de façon optimisée les applications Java dépourvue de fonction cluster :

Configuration File gc_analyzer.pl 
#!/usr/bin/perl -w
 
# Copyright (c) 2008 by mycompany, Inc.  All rights reserved.
# Use is subject to license terms.
 
# Sun Cluster Script v1.3
 
# Pierre Mavro @ mycompany
# Last modification : 27/01/2009 11:45
 
# Supported Sun Solaris cluster Versions :
# 3.0, 3.1, 3.2
 
###################################
#  How to use Sun Cluster script  #
###################################
 
# Requierements :
# - Syslog server on localhost (on each nodes)
# - Perl 5.8 or newer should be installed on the server
# - Perl Module Unix::Syslog (use cpan to install it and Sun Studio Express to compile with cc)
 
# To configure the SUN Cluster mycompany Service, you'll need to add this in the configuration :
# - Start  : PATH_OF_THE_SCRIPT start
# - Stop   : PATH_OF_THE_SCRIPT stop
# - Status : PATH_OF_THE_SCRIPT status
 
# To configure this script, edit the User section.
# If you need advanced functions, edit the advanced user section (by default you needn't)
 
###########
# History #
###########
 
#  Version 1.3 :
# + Add changing files and folders owner while starting
# + More logs on File Handle
# + Deny script execution instead of root
# + Configuration File read in config file optimization
# = Optimization on port verification
# = Optimization on PID check
# = Configuration File optimization
 
# Version 1.2 :
# + Add configuration file
# + Add Solaris package installation
 
# Version 1.1 :
# + Add check installation and configuration
# = Bug when starting with no integration, when PID file was present
 
# Version 1.0 :
# + start / stop /status script
 
########################################################################
########################################################################
 
##################################
#   DO NOT MODIFY THIS SECTION   #
##################################
 
#### Load Perl Librairies ####
use strict;
use POSIX qw(strftime);
use Socket;
use Unix::Syslog qw(:subs :macros);
 
#### Verifications ####
# Exit if's not root user
if ((defined $ENV{'LOGNAME'}) and ($ENV{'LOGNAME'} ne 'root')) {
    print "Sorry, can't execute this command. Please log in as root and try again\n";
    exit 1;
}
 
# Exit if no one arg is defined
&help if (@ARGV ne 2);
 
#### Declare Global Vars ####
my $cluster_version=0;
my $current_mode;
 
### from/to coef file
my $coefprop_value=0;
my $database_size=0;
my $process_time_start=0;
my $process_started=0;
 
# Read config file
my %config;
my $config_file_temp="/tmp/$ARGV[1]\.cfg";
&read_config_file;
 
# Others default vars
$config{japp}="$config{ulapp_path}/lib/$config{jarname}";
$config{uldatabase_path}="$config{ulapp_path}/data";
$config{jbinary_path}="$config{ulapp_path}/bin";
$config{jstartup_script}="$config{jbinary_path}/start.sh";
$config{jstop_script}="$config{jbinary_path}/stop.sh";
$config{jpid_file}="$config{jbinary_path}/pid";
$config{coefprop_file}="$config{ulapp_path}/coefprop";
 
my $ulapp_pid=0;
my $cluster_file_version="/etc/cluster/release";
my $get_date_formated;
my $set_start_timeout_to_cluster;
my $lock_start_file="/tmp/lock_$config{client_name}\_$config{ul_soft_name}";
my $process_checked=0;
my $current_pid=0;
my $get_epoch_time;
my @get_times;
my $get_size;
my $fake_gds_file="$config{jbinary_path}/loop_gds_$config{client_name}\_$config{ul_soft_name}\.sh";
my $client_ulapp=$ARGV[1];
 
#######################
#   Short Functions   #
#######################
 
##### Get functions #####
 
# Get help
sub help {
    print "\nmycompany Cluster Service for Sun Solaris Cluster (SunPlex)\n";
    print "Usage : mycompanycluster [start|stop|status|check] [conf_name]\n";
    print " - start      : start cluster command\n";
    print " - stop       : stop cluster command\n";
    print " - status     : status cluster command\n";
    print " - check      : check installation and configuration\n";
    print " - conf_name  : set config name defined with [] in mycompany.conf\n\n";
    $ulapp_pid=0;
    exit(1);
}
 
# Get database size information
sub get_database_size {
    open (GET_SIZE, "/usr/bin/du -sk $config{uldatabase_path} |") or &sendto_syslog(LOG_ERR, "Error while trying to get database size");
    while (<GET_SIZE>) {
        if ($_ =~ /(\d+).+/ig) {
            $database_size=$1;
        }
    }
    close (GET_SIZE);
}
 
##### File handles functions #####
 
# Get JAVA PID from jpid File
sub get_pid_from_jpid {
    my $open_res=0;
    my $n=0;
    while ((!($open_res = open (JPID_FILER, "<$config{jpid_file}"))) and $n<5) {
        &sendto_syslog(LOG_DEBUG, "Error opening $config{jpid_file} : $!. Waiting for a while");
        sleep 1;
        $n++;
    }
    if (! $open_res) {
        &sendto_syslog(LOG_DEBUG, "Could not open $config{jpid_file}.");
        return $ulapp_pid=0;
    }
    while (<JPID_FILER>) {
        chomp $_;
        if ($_ =~ /(\d+)/ig) {
            $ulapp_pid=$1;
            last;
        }
    }
    close (JPID_FILER);
    &sendto_syslog(LOG_DEBUG, "Got pid from $config{jpid_file} : $ulapp_pid");
    return $ulapp_pid;
}
 
# Get SUN Cluster version to validate cluster commands
sub get_cluster_version {
    # Look if cluster version file exist. If not, SUN cluster isn't installed
    if (-e $cluster_file_version) {
        # Now getting version
        open (CLUSTER_VERSION, "<$cluster_file_version") or &sendto_syslog(LOG_ERR, "Error opening file $cluster_file_version : $!");
        while (<CLUSTER_VERSION>) {
            if ($_ =~ /\s+Sun Cluster (\d\.\d+)(u\d+|).+/ig) {
                $cluster_version=$1;
                &sendto_syslog(LOG_DEBUG, "SUN Cluster version $cluster_version has been detected");
                last;
            }
        }
        close (CLUSTER_VERSION);
    } else {
        # Else exit because don't know which command to use
        &sendto_syslog(LOG_ERR, "Cannot detect SUN Cluster version on $cluster_file_version file");
        exit (1);
    }
}
 
# Get Cluster start timeout
sub get_start_timeout_from_cluster {
    # Get VIP Ressource name from Ressource Group
    my $command=&launch_cluster_commands('cluster_rg_name', '', $config{cluster_rg_name} );
    open (GET_VIP_RS_NAME, "$command |") or &sendto_syslog(LOG_ERR, "Error while trying to launch command : $command");
    while (<GET_VIP_RS_NAME>) {
        chomp $_;
        $config{cluster_vip_ressource_name}=$_;
    }
    close (GET_VIP_RS_NAME);
 
    $command=&launch_cluster_commands('get_timeout', $config{cluster_vip_ressource_name}, '' );
    open (TIME_OUT_START, "$command |") or &sendto_syslog(LOG_ERR, "Error while trying to launch command : $command");
    while (<TIME_OUT_START>) {
        if ($cluster_version =~ /(3.0|3.1)/) {
            if ($_ =~ /$config{cluster_vip_ressource_name}:START_TIMEOUT.+value:.(\d+)/g) {
                $set_start_timeout_to_cluster=$1;
                last;
            }
        } elsif ($cluster_version eq '3.2') {
            if ($_ =~ /^..START_TIMEOUT:\s+(\d+)/g) {
                $set_start_timeout_to_cluster=$1;
                last;
            }
        }
    }
    close (TIME_OUT_START);
}
 
#### COEF FILE ####
 
# Write to coefprop Database size and starting time informations
sub create_coefprop_file  {
    open (COEFPROPFILEW, ">$config{coefprop_file}") or &sendto_syslog(LOG_ERR, "Error opening file $config{coefprop_file} : $!");
        print COEFPROPFILEW "### \u\L$config{client_name} ($config{ul_soft_name}) service informations ###\n";
        printf COEFPROPFILEW '%-35s', "Database size (Ko)";
        print COEFPROPFILEW "= $database_size\n";
        printf COEFPROPFILEW '%-35s', "Starting time";
        print COEFPROPFILEW "= $get_date_formated\n";
    close (COEFPROPFILEW);
}
 
# Append to coefprop PID
sub append_pid_to_coefprop {
    open (COEFPROPFILEW, ">>$config{coefprop_file}") or &sendto_syslog(LOG_ERR, "Error on writing file $config{coefprop_file} : $!");
        printf COEFPROPFILEW '%-35s', "PID";
        print COEFPROPFILEW "= $ulapp_pid\n";
    close (COEFPROPFILEW);
}
 
# Append $rap_rop_value to coefprop file
sub append_coefprop_value_to_coeffile {
    open (COEFPROPFILEW, ">>$config{coefprop_file}") or &sendto_syslog(LOG_ERR, "Error on writing file $config{coefprop_file} : $!");
    printf COEFPROPFILEW '%-35s', "Started time";
    print COEFPROPFILEW "= $get_date_formated\n";
    printf COEFPROPFILEW '%-35s', "Coefficient\ of\ proportionality";
    print COEFPROPFILEW "= $coefprop_value\n";
    close (COEFPROPFILEW);
}
 
 
# Get Coefficient of proportionality with $coefpropfile
sub get_coefprop_value {
        open (COEFPROPFILER, "<$config{coefprop_file}") or &sendto_syslog(LOG_ERR, "Error opening file $config{coefprop_file} : $!");
        while (<COEFPROPFILER>) {
            chomp $_;
            if ($_ =~ /Coefficient\ of\ proportionality\s*=\s*(.+).*/gi) {
                $coefprop_value=$1;
                &sendto_syslog(LOG_NOTICE, "ratio has been found in coefprop file and setting up to $coefprop_value");
            }
        }
        close (COEFPROPFILER);
}
 
sub get_database_size_from_coeffile {
    if (-e $config{coefprop_file}) {
        # $coefprop_value should be the one in the coefficient of proportionality file
        &get_coefprop_value;
        open (COEFPROPFILER, "<$config{coefprop_file}") or &sendto_syslog(LOG_ERR, "Error opening file $config{coefprop_file} : $!");
        while (<COEFPROPFILER>) {
            chomp $_;
            if ($_ =~ /Database\ size\ \(Ko\)\s*=\s*(\d+)/ig) {
                $database_size=$1;
            }
        }
        close (COEFPROPFILER);
    } else {
        &sendto_syslog(LOG_NOTICE, "couldn't determine ratio, coefprop file hasn't been found ($config{coefprop_file})");
        &default_coefprop;
    }
}
 
#### TEMP FILE ####
 
# Write to $config{temp_file} PID
sub write_pid_to_temp_file {
    # Write PID to temp file
    open (TEMP_FILE, ">$config{temp_file}") or &sendto_syslog(LOG_ERR, "Error opening file $config{temp_file} : $!");
        printf TEMP_FILE '%-35s', 'PID';
        print TEMP_FILE "= $ulapp_pid\n";
    close (TEMP_FILE);
}
 
# Get JAVA PID from temp File
sub get_pid_from_temp {
    open (TEMP_FILER, "<$config{temp_file}") or &sendto_syslog(LOG_ERR, "Error opening file $config{temp_file} : $!");
    while (<TEMP_FILER>) {
        chomp $_;
        if ($_ =~ /^PID\s*=\s*(.+)/ig) {
            $ulapp_pid=$1;
            last;
        }
    }
    close (TEMP_FILER);
    return $ulapp_pid;
}
 
##### Actions functions #####
 
# Read config file
sub read_config_file {
    my $use_config_file_temp=0;
 
    # Set config file
    my $config_file='/etc/mycompany/mycompany.cfg';
    if ((-f $config_file_temp) and (-r $config_file_temp)) {
        $config_file=$config_file_temp;
        $use_config_file_temp=1;
    }
 
    # Exit if config file is not found
    unless ((-f $config_file) && (-r $config_file)) {
        print "Sorry but $config_file couldn't be determined, please create one before starting\n";
        exit 1;
    }
 
    my $config_founded=0;
    # Open Config file and stock content in %config hash
    open (READ_CONFIG, "<$config_file") or &sendto_syslog(LOG_ERR, "Error opening file $config_file : $!");
 
    while (<READ_CONFIG>) {
        chomp $_; 
        # Flushing comments
        s/#.*$//;
 
        # Searching [] to start config read
        if ($config_founded eq 0) {
            if (/^\[$ARGV[1]\]/) {
                $config_founded=1;
            } elsif (/^\[-.*/) {
                $config_founded=0;
            }   
            next;
        }   
        # When found, analyze content and push to tabs
        if ($config_founded eq 1) {
            if (/(\w+).*=\s*(\S+)/) {
                $config{$1} = $2; 
            } elsif (/^\[/) {
                last;
            }   
        }   
    }
    close READ_CONFIG;
 
    # Create others vars if not already done
    if ($use_config_file_temp eq 0) {
        my $key;
        my $value;
 
        # Set real path to $config{ulapp_path}
        my $new_config_key=$config{ulapp_path};
        delete($config{ulapp_path});
        $config{ulapp_path}="$new_config_key/$config{client_name}\_$config{ul_soft_name}";
        $new_config_key=$config{temp_file};
        delete($config{temp_file});
        $config{temp_file}="$new_config_key/$config{client_name}\_$config{ul_soft_name}\_temp";
 
        # Write configuration to $temp_file_temp
        open (WRITE_CONFIG_TEMP, ">$config_file_temp") or &sendto_syslog(LOG_ERR, "Error on writing file $config_file_temp : $!");
 
        print WRITE_CONFIG_TEMP "[$ARGV[1]]\n";
        while (($key, $value) = each(%config)){
            print WRITE_CONFIG_TEMP "\t$key = $value\n";
        }
        close (WRITE_CONFIG_TEMP);
    }
}
 
# Check if process has a valid PID number
sub status_process_check {
    if (&check_process != $ulapp_pid) {
        &sendto_syslog(LOG_ERR, "process with PID $ulapp_pid, couldn't be found");
        return 1;
    } else {
    	return 0;
    }
}
 
# Secure coefficient of proportionality value
sub default_coefprop {
    $config{add_start_interval_time}=300;
    $coefprop_value=0.001;
    &sendto_syslog(LOG_NOTICE, "couldn't determine ratio, setting up a secure additional interval to $config{add_start_interval_time} seconds and a ratio of $coefprop_value");
}
 
# Sun Cluster 3.0 and 3.1 commands
sub launch_cluster_commands {
    my %cluster_commands;
    if ($cluster_version =~ /(3.0|3.1)/g) {
        %cluster_commands = (
            "get_timeout"       => "/usr/cluster/bin/scrgadm -pvv",
            "set_start_timeout" => "/usr/cluster/bin/scrgadm -c -j $_[2]\_script -y start_timeout=$_[1]",
            "cluster_rg_name"   => "/usr/cluster/bin/clrs list -g $_[2] -t SUNW.LogicalHostname:2",
            "clusterstatus"     => "cluster status",
        );
    # Sun Cluster 3.2 commands
    } elsif ($cluster_version eq '3.2') {
        %cluster_commands = (
            "get_timeout"       => "/usr/cluster/bin/clrs show -v $_[2]",
            "set_start_timeout" => "/usr/cluster/bin/clrs set -p start_timeout=$_[1] $_[2]\_script",
            "cluster_rg_name"   => "/usr/cluster/bin/clrs list -g $_[2] -t SUNW.LogicalHostname:2",
            "clusterstatus"     => "csstat",
        );
    } else {
        &sendto_syslog(LOG_ERR, "SUN Cluster version couldn't be determined, can't execute your requested command ($_[0] on $_[2] with a timeout of $_[1])");
        exit (1);
    }
    return "$cluster_commands{$_[0]}";
}
 
# Send logs to syslog server service
sub sendto_syslog {
    # Use Syslog to logs script messages (usually in /var/adm/messages)
    # Change your syslog.conf if you need to customize
    openlog("\u\L$config{client_name} ($config{ul_soft_name}) [$ulapp_pid]", LOG_NDELAY, LOG_DAEMON);
        # If DEBUG mode is enable, print DEBUG logs to syslog
        if ($config{enable_debug} eq 'on') {
            setlogmask(LOG_MASK(LOG_DEBUG) | LOG_MASK(LOG_ERR) | LOG_MASK(LOG_NOTICE));
        } else {
            setlogmask(LOG_MASK(LOG_ERR) | LOG_MASK(LOG_NOTICE));
        }
        syslog($_[0], "$_[1]");
    closelog;
}
 
#####################
#   Big Functions   #
#####################
 
##### Checks functions #####
 
# Check UL App processus start
sub check_process {
    my $check_counter=0;
    $process_time_start=0;
    my $good_format;
 
    # Looking for process state to get started (3 checks to validate)
    while ($check_counter ne 3) {
        my $process_check_ok=0;
 
        # If $config{max_time_create} has been reached, cluster application restart
        if ($config{max_time_create} <= $process_time_start) {
            # Only use $config{max_time_create} at start
            if ($current_mode eq 'start') {
                return 0;
            } elsif ($current_mode eq 'integrate') {
                &sendto_syslog(LOG_NOTICE, "process couldn't get into the cluster because process wasn't found. Now starting normally");
                return 0;
            } elsif ($current_mode eq 'status') {
                return 0;
            }
        }
 
        # Check if PID's Ulapp exists
        $process_check_ok=0;
        if (kill 0, $ulapp_pid) {
            # Process found for start
            $process_check_ok=1;
            last;
        }
 
        $good_format = printf('%05s', $process_time_start);
        &sendto_syslog(LOG_DEBUG, "DEBUG Starting Process [$ulapp_pid] : [Max time : $config{max_time_create} | Time $current_mode : $good_format | Validated : $check_counter | Found : $process_check_ok]");
 
        # Increase if found
        if ($process_check_ok eq 1) {
            $check_counter++;
        } else {
            $check_counter=0;
        }
 
        # Increase $process_time_start
        $process_time_start++;
 
        # Wait 1 sec before looping
        sleep 1;
    }
 
    # If all checks successfully passed, return PID
    return $ulapp_pid;
}
 
# Check UL App processus stop
sub check_process_stop {
    my $check_counter=0;
    my $process_time_stop=0;
    my $process_check_ok;
    my $good_format;
    # Since Ulbridge 2.4.5 timeout for adapters is 10 min max
    my $max_time_stop = $config{max_time_stop} + 600;
 
    # Looking for process state to get started (3 checks to validate)
    while ($check_counter ne 3) {
        $process_check_ok=1;
 
        # If $max_time_stop has been reached, return 0
        return 0 if ($max_time_stop <= $process_time_stop);
 
        # Check if PID's Ulapp exists
        unless (kill 0, $ulapp_pid) {
            $process_check_ok=0;
            $check_counter++;
        } else {
            $check_counter=0;
        }
 
        $good_format=sprintf('%05s', $process_time_stop);
        &sendto_syslog(LOG_DEBUG, "DEBUG Stopping Process [$ulapp_pid] : [Max time : $max_time_stop | Time $current_mode : $good_format | Validated : $check_counter | Found : $process_check_ok]");
 
        # Increase $process_time_stop and counter
        $process_time_stop++;
 
        # Wait 1 sec before looping
        sleep 1;
    }
 
    # If all checks successfully passed, return 1
    return 1;
}
 
## Port Listener Check Function ##
sub check_port_listen {
    my $check_counter=0;
    my $good_format_port;
    my $port_counter=0;
    my $port_open_timeout=0;
 
    # Truncate and add 1
    my $truncate_max_time_port_create=sprintf '%.0f', $config{max_time_port_create};
    $config{max_time_port_create}=$truncate_max_time_port_create + 1;
 
    # Looking if port is opened (3 checks to validate)
    while ($check_counter ne 3) {
 
        # If max time has been reached, cluster application restart
        if ($port_open_timeout >= $config{max_time_port_create}) {
            # Only use $config{max_time_port_create} at start
            if ($current_mode eq 'start') {
                &sendto_syslog(LOG_ERR, "port hasn't been opened in it's due time ($config{max_time_port_create} seconds)");
                exit (1);
            } elsif ($current_mode eq 'integrate') {
                &sendto_syslog(LOG_NOTICE, "port is not open");
                # For other arguments
                return 0;
            } elsif ($current_mode eq 'status') {
                return 0;
            }
        }
 
        # Increment port_counter to check if process is still alive
        if ($port_counter eq 6) {
            if (&check_process eq $current_pid) {
                $port_counter=0;
                $port_open_timeout = $port_open_timeout + $process_time_start;
            } else {
                return 2;
            }
        } else {
            $port_counter++;
        }
 
        # Check if port's Ulapp is opened
        my $port_found=0;
        socket(SOCK, PF_INET, SOCK_STREAM, getprotobyname('tcp'));
        $port_found = 1 if (connect(SOCK, sockaddr_in($config{ul_soft_port_listening}, inet_aton('localhost'))));
        close (SOCK);
 
        $good_format_port=sprintf('%04s', $port_open_timeout);
        &sendto_syslog(LOG_DEBUG, "DEBUG Port : [Max create = $config{max_time_port_create} | Time open = $good_format_port | Counter = $port_counter |  Found = $port_found]");
 
        # Increase if found else erase
        if ($port_found eq 1) {
            $check_counter++;
        }
 
        # If script is launching at start increase $port_open_timeout
        $port_open_timeout++;
 
        # Wait 1 sec before looping
        sleep 1;
    }
    return 1;
}
 
## CLI command checker ##
sub check_cli {
    my $check_counter=0;
    my $cli_validated=0;
    my $cli_counter=0;
 
    while ($cli_validated ne 3) {
 
        if ($cli_counter >= $config{max_cli_command_retry}) {
            &sendto_syslog(LOG_ERR, "Coulnd't catch CLI validation");
            return 0;
        }
 
        # Launching CLI command
        if ($config{ul_soft_name} eq 'ulbridge' ) {
            open (CHECK_CLI, "java -jar $config{japp} -login $config{cli_account_login} -password $config{cli_account_password} -port $config{ul_soft_port_listening} view $config{ul_soft_name} |") or &sendto_syslog(LOG_ERR, "Error on ch
ecking CLI command");
        } elsif ($config{ul_soft_name} eq 'ulodisys') {
            open (CHECK_CLI, "java -jar $config{japp} -login $config{cli_account_login} -password $config{cli_account_password} -port $config{ul_soft_port_listening} help |") or &sendto_syslog(LOG_ERR, "Error on checking CLI command");
        }
        while (<CHECK_CLI>) {
            chomp $_;
            if ($_ =~ /($config{cli_match_words})/gi) {
                $check_counter++;
            }
        }
        close (CHECK_CLI);
 
        # Increase counter
        if ($check_counter >= 2) {
            $cli_validated++;
        } else {
            $cli_validated=0;
        }
 
        &sendto_syslog(LOG_DEBUG, "DEBUG CLI : [Validated = $cli_validated | Valid (=2) = $check_counter | Counter = $cli_counter]");
 
        # Increase if found
        $cli_counter++;
 
        # Resetting counter
        $check_counter=0;
    }
    return 1;
}
 
######################
#   Main Functions   #
######################
 
## Cluster start ##
sub start {
    # Get Cluster version first
    &get_cluster_version;
 
    # Set default mode as start
    $current_mode='start';
 
    # Put lock file
    open (LOCK_START, ">$lock_start_file") or &sendto_syslog(LOG_ERR, "Error on writing $lock_start_file file");
    close(LOCK_START);
 
    # Get COEFPROPFILE informations
    &get_database_size_from_coeffile;
 
    # Verify if $coefprop_value has been defined
    if ($coefprop_value == 0) {
        &default_coefprop;
    }
 
    # Looking if UL application is already started to integrate it in the cluster
    # Verify if UL Application PID exist and contain PID
    # Then get clluster informations and try to integrate the application in the cluster
    if (-e $config{jpid_file}) {
        &get_pid_from_jpid;
        &integrate_ulapp_to_cluster;
    } elsif (-e $config{temp_file}) {
        &get_pid_from_temp;
        &integrate_ulapp_to_cluster;
    }
 
    # Reassign good rights
    system "chown", "-Rf", "$config{cli_account_login}", "$config{ulapp_path}";
 
    # Get database size
    &get_database_size;
 
    # Get actual date
    $get_date_formated = strftime "%d-%m-%y %H:%M:%S", localtime;
 
    # Creating or overriding coefprop file
    &create_coefprop_file;
 
    # Stock Epoch time
    push @get_times, time;
 
    # Removing PID file, launching mycompany Application, and send parent PID to temp file
    unlink $config{jpid_file} if (-e $config{jpid_file});
    system "/usr/bin/su - $config{ul_owner} -c $config{jstartup_script} &>$config{ulapp_path}/logs/cluster_output_problems";
 
    # Get PID
    &get_pid_from_jpid;
 
    # Check PID
    if (&check_process == 0) {
        &sendto_syslog(LOG_ERR, "process has not started in it's due time ($config{max_time_create} seconds)");
        unlink $lock_start_file, $config_file_temp;
        exit (1);
    } else {
        $current_pid=$ulapp_pid;
 
        # Write PID to coefprop file
        &append_pid_to_coefprop;
 
        # Print to logs when process has successfully started
        &sendto_syslog(LOG_NOTICE, "process has successfully started at PID : $ulapp_pid");
 
        # Evaluate starting time
        $config{max_time_port_create}=($coefprop_value * $database_size) + $config{add_start_interval_time};
 
        # Check Port Listener
        if (check_port_listen() == 1) {
            &sendto_syslog(LOG_NOTICE, "port has successfully been opened on : $config{ul_soft_port_listening}");
        } else {
            &sendto_syslog(LOG_NOTICE, "port could not be openned ($config{ul_soft_port_listening}) in it's due time ($config{max_time_port_create} seconds), please check $config{ul_soft_name} logs");
            exit (1);
        }
 
        # Check CLI command
        &check_cli if ($config{ul_soft_name} ne 'ulodisys');
 
        # Stock Epoch time and get actual date/time
        push @get_times, time;
        $get_date_formated = strftime "%d-%m-%y %H:%M:%S", localtime;
 
        # Stock proportionnality report value
        $coefprop_value=($get_times[1] - $get_times[0]) / $database_size;
 
        # Append $rap_rop_value to coefprop file
        &append_coefprop_value_to_coeffile;
 
        # Write PID to temp file
        &write_pid_to_temp_file;
 
        # Remove lock file
        unlink $lock_start_file;
 
        # Print to logs when the CLI has been validated
        &sendto_syslog(LOG_NOTICE, "service has successfully started");
 
    	# All is fine, normal exit
    	exit(0);
    }
}
 
## Cluster integration ##
sub integrate_ulapp_to_cluster {
    if ($ulapp_pid ne 0) {
        $current_mode='integrate';
        # If PID file match with current process, continue checks
        $current_pid=$ulapp_pid;
        if ($current_pid == &check_process) {
            &sendto_syslog(LOG_NOTICE, "Process found, try to integrate service into cluster");
            if (check_port_listen() == 1) {
                if (check_cli() == 1) {
                    # Creating or overriding coefprop file
                    $get_date_formated="UNKNOW (Because of integration)";
                    &create_coefprop_file;
                    &append_pid_to_coefprop;
 
                    # Get actual date
                    $get_date_formated = strftime "%d-%m-%y %H:%M:%S", localtime;
 
                    # Add integrate time
                    open (COEFPROPFILEW, ">>$config{coefprop_file}") or &sendto_syslog(LOG_NOTICE, "Error on writing file : $config{coefprop_file}");
                        printf COEFPROPFILEW "%-35s", "Integration time";
                        print COEFPROPFILEW "= $get_date_formated\n";
                        printf COEFPROPFILEW "%-35s", "Coefficient of proportionality";
                        print COEFPROPFILEW "= $coefprop_value\n";
                    close (COEFPROPFILEW);
 
                    # Write PID to temp file
                    &write_pid_to_temp_file;
 
                    # To avoid log error message "Cluster.PMF.pmfd...Failed to Stay up"
                    # I need to fake PMF verifycation
 
                    # Write GDS fake file
                    open (GDS_FAKE, ">$fake_gds_file") or &sendto_syslog(LOG_NOTICE, "Error on writing file : $fake_gds_file");
                    my $create_gds_fake_file = <<"GDSH";
#!/bin/sh
# This file has been created because mycompany service
# has been integrated to cluster. This loop make GDS
# believe that the application is running
 
while [ 1 ] ; do
    sleep 3600
done
GDSH
                    print GDS_FAKE $create_gds_fake_file;
                    close (GDS_FAKE);
 
                    # Set good rights
                    chmod 0777, "$fake_gds_file";
 
                    # Remove lock file
                    unlink $lock_start_file;
 
                    # Launch gds fake
                    system "/usr/bin/su - $config{ul_owner} -c $fake_gds_file 1>/dev/null &";
 
                    # Successfully integrated
                    &sendto_syslog(LOG_NOTICE, "service has successfully been integrated");
 
                    exit (0);
                } else {
                    &sendto_syslog(LOG_NOTICE, "service couldn't be integrated in cluster because CLI didn't match with requiered values. Now starting in default mode");
                }
            } elsif (check_port_listen() == 0) {
                &sendto_syslog(LOG_NOTICE, "service couldn't be integrated in cluster because port hasn't been opened in it's due time ($config{max_time_port_create}). Now starting in default mode");
            } elsif (check_port_listen() == 2) {
                &sendto_syslog(LOG_NOTICE, "service couldn't be integrated in cluster because process didn't match anymore (has may changed) during a port checking. Now starting in default mode");
            }
        } else {
            &sendto_syslog(LOG_NOTICE, "service couldn't be integrated in cluster because process PID ($current_pid) didn't match with the current process found. Now starting in default mode");
        }
    }
}
 
## Cluster stop ##
sub stop {
    # Get Cluster version first
    &get_cluster_version;
 
    # Set current mode
    $current_mode='stop';
 
    # Get PID from temp file
    if (-e $config{temp_file}) {
        &get_pid_from_temp;
    } elsif (-e $config{jpid_file}) {
        &get_pid_from_jpid;
    } else {
        &sendto_syslog(LOG_ERR, "process couldn't be stopped because process couldn't be located ($config{temp_file})");
        exit(1);
    }
 
    # Check if PID respond
    if (&check_process == $ulapp_pid) {
        # Get database size
        &get_database_size;
 
        # Launch stop command
        system "/usr/bin/su - $config{ul_owner} -c $config{jstop_script} 2>&1 >>$config{ulapp_path}/logs/cluster_output_problems";
 
        # Exit in error if process is still alive
        if (&check_process_stop == 0) {
            &sendto_syslog(LOG_ERR, "Could not stop properly $config{client_name}\_$config{ul_soft_name}, exit in error");
            exit 1;
        }
 
        # Remove temp files and PID file
        unlink $config{temp_file}, $config{jpid_file}, $config_file_temp;
 
        # If $fake_gds_file exist kill PID
        if (-e "$fake_gds_file") {
            open (GET_FAKE_GDS_PID, "/usr/bin/ps -fu $config{ul_owner} -o pid,args |");
            while (<GET_FAKE_GDS_PID>) {
                chomp $_;
                if ($_ =~ /(\d+).+($fake_gds_file|sleep 3600$)/gi) {
                    kill 9, $1;
                }
            }
            # Remove loop file
            unlink $fake_gds_file;
        }
 
        # Get coefprop value and database size to update default start timeout
        &get_coefprop_value;
        &get_database_size;
 
        # Evaluate starting time
        my $temp_start_timeout=($coefprop_value * $database_size) + $config{add_start_interval_time};
 
        # Truncate value
        $config{max_time_port_create} = sprintf('%04s', $temp_start_timeout);
 
        # Minimum start timeout is 60s, check if it's possible or not
        $config{max_time_port_create} = 60 if ($config{max_time_port_create} < 60);
 
        # Set the default start timeout for next start
        system &launch_cluster_commands('set_start_timeout', $config{max_time_port_create}, "$config{client_name}\_$config{ul_soft_name}");
 
        &sendto_syslog(LOG_NOTICE, "process has been successfully stopped and all temp files flushed");
        exit(0);
    } else {
        &sendto_syslog(LOG_ERR, "Could not stop propperly service, please check $config{ul_soft_name} logs");
        exit(1);
    }
}
 
## Cluster status / probe ##
sub status {
    my $process_present='Process, ';
 
    # Set current mode
    $current_mode='status';
 
    # Check if process is alive
    sub is_process_alive {
    	if (&status_process_check ne 1) {
        	$process_checked=1;
        } else {
        	&sendto_syslog(LOG_ERR, "process could not be found, switching node");
        	exit (201);
        }
    }
 
    # Get PID from temp file
    if (-e $config{temp_file}) {
        &get_pid_from_temp;
		&is_process_alive;
    } elsif (-e $config{jpid_file}) {
        &get_pid_from_jpid;
        &is_process_alive;
    } else {
        &sendto_syslog(LOG_ERR, "couldn't get status informations, PID $config{jpid_file} and $config{temp_file} files don't exist, try to status anyway");
        $process_present='';
    }
 
    # Check if port is open
    $config{max_time_port_create}=$config{max_time_create};
    if (check_port_listen() != 1) {
        &sendto_syslog(LOG_ERR, "Port is not open on $config{ul_soft_port_listening}");
        exit (201);
    }
 
    # Check CLI command
    if ($config{ul_soft_name} ne 'ulodisys') {
        if (check_cli() != 1) {
            &sendto_syslog(LOG_ERR, "Port couldn't be found");
            &sendto_syslog(LOG_NOTICE, "CLI command mismatch");
            exit(201);
        }
    }
 
    # If all tests are sucessfull exit normaly
	&sendto_syslog(LOG_NOTICE, "$process_present" . "Port and CLI has been checked. Status OK");
    exit(0);
}
 
sub check_install {
	sub say_ok {
		print "[  OK  ]\n";
	}
 
	sub say_fail {
		print "[ FAIL ]\n";
	}
 
	# Print a nice menu
	print "\n                ###########################################\n";
	print "                # Installation and Configuration checking #\n";
	print "                ###########################################\n\n\n";
 
	# Check if user has a name less than 8 chars (because of a ps command bug)
	my $ul_owner_size_char = length($config{ul_owner});
	printf '%-80s', "Checking lenght of owner name";
	if ($ul_owner_size_char < 8) {
		&say_ok;
	} else {
		&say_fail;
		print "* Change owner name to have less than 8 chars (actually $config{ul_owner}_size_char chars : $config{ul_owner})\n\n";
	}
 
    # Checking if $config{ulapp_path} exist and is in lowercase
    printf '%-80s', "Checking if $config{ulapp_path} and is in lowercase";
    if (-d $config{ulapp_path}) {
        if ($config{ulapp_path} =~ /\L$config{ulapp_path}/) {
            &say_ok;
        } else {
            &say_fail;
            print "* Folder $config{ulapp_path} should not contain uppercase\n\n";
        }
    } else {
        &say_fail;
	    print "* Couldn't locate $config{ulapp_path} : $!\n\n";
        print "Could not continue check anymore, please correct this problem first\n";
        exit (1);
	}
 
	# Checking rights
	printf '%-80s', "Checking rights on SAN for $config{ulapp_path}";
    # Get owner from $config{ulapp_path} folder
    my $name = getpwuid((stat($config{ulapp_path}))[4]);
    if ($name eq $config{ul_owner}) {
        # Get right from $config{ulapp_path} folder
        my $mode = sprintf("%04o", (stat($config{ulapp_path}))[2] & 07777);
        if ($mode =~ /\d(\d)\d\d/) {
            if ($1 eq 7) {
                &say_ok;
            } else {
                &say_fail;
                print "* You need to have all the rights for $config{ul_owner} on this $config{ulapp_path} folder\n";
            }
        }
    } else {
        &say_fail;
        print "* Folder $config{ulapp_path} is owned by $name and should be by $config{ul_owner}\n\n";
    }
 
    # Checking syslog config
	printf '%-80s', "Checking syslogd configuration for debug mode";
    my $found_debug_syslog=0;
    open (CFG_SYSLOGD, "</etc/syslog.conf") or &sendto_syslog(LOG_ERR, "Error on reading file /etc/syslog.conf : $!");
    while (<CFG_SYSLOGD>) {
        chomp $_;
        if (($_ =~ /daemon.debug.+\/var\/adm\/messages/g) and !(/^#.+/)) {
            &say_ok;
            $found_debug_syslog=1;
            last;
        }
    }
    close (CFG_SYSLOGD);
 
    if ($found_debug_syslog == 0) {
        &say_fail;
        print "* Add 'daemon.debug' to your /etc/syslog.conf file where '/var/adm/messages' is present\n\n";
    }
 
}
 
#########################
#   Arguments choices   #
#########################
 
if ($ARGV[0] eq 'start') {
    &start;
} elsif ($ARGV[0] eq 'stop') {
    &stop;
} elsif ($ARGV[0] eq 'status') {
    while (-e $lock_start_file) {
        sleep 1;
    }
    &status;
} elsif ($ARGV[0] eq 'check') {
	&check_install;
} else {
    &help;
}

Retrieved from "https://wiki.deimos.fr/index.php?title=Mes_scripts_Perl_qui_peuvent_servir_d%27exercices&oldid=11011"