Perl : File Locking using flock

As a application server admin, it do have to write scripts for various automation operations in weblogic. One such task to do deploy application in weblogic. As we know that Weblogic domain does not allow multiple operations to be performed at same time. We have to take a lock first and then perform action, if a lock is already been taken by a different operation a message is sent back saying “lock already taken“.

In my case ,we have our own scripts which will do a deployments in weblogic for us . we have used WLST for doing the actual deployment. Now my task is make sure that only 1 deployment is being performed on a domain and every second one should wait until the first one is completed. This is much like a locking stuff.

Perl provide us with many modules that help many of the administrative tasks easy. One such module is perl::FLOCK. This module allows one to take a lock on a file and hold it. Lets write a sample script and see how it works

Here is a Sample Script that i wrote for my testing purpose.

#!/usr/bin/perl

#  --------

#  PROGRAM:  lock.pl  (Sample Script for Flock Test)

#  --------

$LOCK_EXCLUSIVE                   = 2;

$UNLOCK                      = 8;

$LOCK_SHARED                        = 1;

$LOCK_NONBLOCKING = 4;

# open the file, lock the file, sleep, then write, then unlock the file, then close the file.

open (FILE, ">> test.dat") || die "problem opening test.dat\n"; 

flock FILE, $LOCK_EXCLUSIVE;

sleep 10;

print FILE "this line printed by lock.pl\n";

flock FILE, $UNLOCK;

close(FILE);

In the above case , we are taking a lock on the test.dat file and sleeping for a 10 second , then writing content to it and then un locking.

There are 4 locks available

shared lock : Shared lock can be shared with other process too. If a process takes a lock for reading a file which has a Shared lock , another process can take the lock on the same file for reading .This lock is normally applied when you just want to read the file

exclusive lock : This is the lock iam planning to use in the code, this lock is used when you want to make changes to the file. Only one exclusive lock can be on a file, so that only one process at a time can make changes. 

non-blocking : non-blocking lock request so that the process does not have to wait if an incompatible lock is held by another process; instead the process can take some other action.

unlock: unlock the lock. normally call to this is not use full. coz once a process releases the lock , the unlock is called automatically.

Now this sample also checks whether the file is already been locked. This is a sample logic

#!/usr/bin/perl

$LOCK_EXCLUSIVE         = 2;

$UNLOCK                     = 8;

$LOCK_SHARED            = 1;

$LOCK_NONBLOCKING    = 4;

# -----------------------

# What's about to happen:

# -----------------------

# open the file, try to lock the file, then write, then unlock the

# file, then close the file.

open (FILE, ">> test.dat") || die "problem opening test.dat\n";

if ( is_file_locked($FILE) ){ print "locked\n";} else { print "not locked\n";}

flock FILE, $LOCK_EXCLUSIVE;

print FILE "this line printed by try.pl\n";

flock FILE, $UNLOCK;

close(FILE);

sub is_file_locked

{

  my $theFile;

  my $theRC;

  ($theFile) = @_;

  $theRC = open(my $HANDLE, ">>", $theFile);

  $theRC = flock($HANDLE, LOCK_EX|LOCK_NB);

  close($HANDLE);

  return !$theRC;

}

The above script will also check whether the lock is being taken or not

Now for my actual task , I have to use the same lock technology and make sure my second process checks the lock continuously and when it is available we need to perform some action.

Here is the sample code for that

#!/usr/bin/perl

#  --------

#  PROGRAM:  try.pl  (Sample Flock Script)

#  --------

$LOCK_EXCLUSIVE         = 2;

$UNLOCK                 = 8;

$LOCK_SHARED            = 1;

$LOCK_NONBLOCKING       = 4;

#Get the Domain Name for the Cluster Passed

my @values = split('-', $ARGV[0]);

my $cluster= $values[0];

my $lock_file="/logs/jas/jagadish/$cluster.lock";

for (;;)

{

   # See if lock Status has changed.

   my $lock_status=check_lock_exists();

   if ($lock_status == 0)

   {

       print "-----Lock  exist,sleeping for 10------\n";

      # lock Status Changed.

      # Sleep for 10 to Check the Lock status again

       sleep(10);

   }

   else

   {

      get_lock();

      exit 0;

   }

}

#Sub Routine to Check Whether the Lock File Exists

sub check_lock_exists() {

  

   my $status;

   if (-e $lock_file) {

        $status = 0;

    } else {

        $status  = 1;

    }

  

   return $status;

 }

sub get_lock()    {

     open (FILE, ">>$lock_file") || die "problem opening lock File\n";

     flock FILE, $LOCK_EXCLUSIVE;

     print "----Obtained Lock----\n";

     sleep 20;

     flock FILE, $UNLOCK;

     close(FILE);

     unlink($lock_file) or die "can't remove lockfile: $lockfile ($!)";

}

This script works in such a way ,

1. For the First time deployment , the script will checks for the Domain and create a lock file in the specified location with the domain name , like MyDomain.lock. For every domain , the lock file is created with domainName.lock so that we can check if multiple deployments are going to same domain.

2. The second  deployment will check the domain and if a domain lock file exists in the location ( the deployment is happening or lock was taken ) , it will continuously wait until the lock is released ( The lock file is deleted at the end and the second deployment will create the same lock file for the deployment ).Here are the testing

First Window

[djas999@vx181d jagadish]$ perl getlock.pl MyDomain

----Obtained Lock----

Second Window

[djas999@vx181d jagadish]$ perl getlock.pl MyDomain

-----Lock  exist,sleeping for 10------

-----Lock  exist,sleeping for 10------

----Obtained Lock----

Thrid Window

[djas999@vx181d jagadish]$ perl getlock.pl MyDomain

-----Lock  exist,sleeping for 10------

-----Lock  exist,sleeping for 10------

-----Lock  exist,sleeping for 10------

-----Lock  exist,sleeping for 10------

----Obtained Lock----

In the above case ( all ran at same time ) , the domain i have chosen is MyDomain and the  script will continuously check for the lock until it is released or not available.

Read More

Perl Modules : LWP

Now days, there are many ways to access a web page. We can directly access the web page or we can download the web page using different tools.

In this article we will see how we can access the web page using Perl which allows downloading the web page data and processing it or changing it in the way we need. There are many Perl libraries which actually do the processing of web pages. In this article we will see a Perl module LWP::Simple 

Basics

In the below basic example,we are connecting to the google.com and downloading it to a variable called content. Now when you print the variable we can see the html elements of the web page.

#!/usr/bin/perl

use strict;

use warnings;

use LWP::Simple;

my $content = get('https://www.google.com') or die 'Unable to get page';

print $content;

exit 0;

We can also use the LWP::Simple to directly get the webpage or print the web page directly to the STDOUT like

#!/usr/bin/perl

use strict;

use warnings;

use LWP::Simple;

getprint('https://www.google.com’) or die 'Unable to get page';

exit 0;

In another way , we can make the web page downloaded it copied to a new file like,

#!/usr/bin/perl

use strict;

use warnings;

use LWP::Simple;

getstore('https://www.google.com', 'test.html') or die 'Unable to get page';

exit 0;

This downloaded the file into a test.html file.

Sometimes  it only makes sense to store a document if it's been updated. We can do this with the mirror function, which takes the same arguments as the getstore function:

mirror('http://google.com', 'google.html');

All the above LWP Functions return the HTTP Status Code. We can use those to compare like,

my $response_code = getprint('https://google.com');print "nOKn" if ($response_code == RC_OK);

LWP in Object Oriented Way

If we want to do more things with the web page, we can go with the LWP Object oriented way using the LWP::UserAgent package.

#!/usr/bin/perl

 use strict;

 use warnings;

 use LWP::UserAgent;

 use HTTP::Request::Common qw(GET);

 use HTTP::Cookies;

 my $ua = LWP::UserAgent->new;

 # Request object

 my $req = GET 'https://www.google.com';

 # Make the request

 my $res = $ua->request($req);

# Check the response

    if ($res->is_success) {

        print $res->status_line( );

    } else {

        print $res->status_line . "\n";

    }

 exit 0;

The above is the sample example which access the webpage ,but we only print the Status of the Request.

The first step is to define the Necessary packages like

use LWP::UserAgent;

use HTTP::Request::Common qw(GET);

use HTTP::Cookies;

lets define our User Agent and this is the object that acts as a browser and makes requests and receives responses.

my $ua = LWP::UserAgent->new;

Once the agent is defined we can now define the request object which will be used to request a url like

my $req = GET 'https://www.google.com';

Since we are using the HTTP::Request::Common module, we can use a GET method which accepts a url as the first argument.

We can also pass arguments like

my $req = GET 'https://www.google.com' , [name => 'me', age => 24];

Once the request object is defined, we can use the User Agent to make the request like

my $res = $ua->request($req);

The request method returns a HTTP::Response object. This object contains the status code of the response, and the content of the page if the request was successful.

We can check the response of the Objects and we can also print the obtained content

Basic GET Example

#!/usr/bin/perl

use LWP::UserAgent;

my $ua = LWP::UserAgent->new;

my $server_endpoint = "http://vx1379:10011/wam_wls_monitor";

# set custom HTTP request header fields

my $req = HTTP::Request->new(GET => $server_endpoint);

#$req->header('content-type' => 'application/json');

#$req->header('x-auth-token' => 'jklasdhjklsa');

my $resp = $ua->request($req);

if ($resp->is_success) {

    my $message = $resp->decoded_content;

    print "Received reply: $message\n";

}

else {

    print "HTTP GET error code: ", $resp->code, "\n";

    print "HTTP GET error message: ", $resp->message, "\n";

}

Basic POST Example

use LWP::UserAgent;

my $ua = LWP::UserAgent->new;

my $server_endpoint = "http://vx1379:10011/wam_wls_monitor";

# set custom HTTP request header fields

#my $req = HTTP::Request->new(POST => $server_endpoint);

#$req->header('content-type' => 'application/json');

#$req->header('x-auth-token' => 'jklasdhjklsa');

my $resp = $ua->request($req);

if ($resp->is_success) {

    my $message = $resp->decoded_content;

    print "Received reply: $message\n";

}

else {

    print "HTTP GET error code: ", $resp->code, "\n";

    print "HTTP GET error message: ", $resp->message, "\n";

}

More To Come , Happy learning

Read More

Perl Modules : Xml Parsing In perl

Parsing Text Files is always an easy way using perl .As a System Admin there was a requirement for adding Data Sources using the Perl.

In Tomcat or Jboss we do have the Context.xml or xx-ds.xml file where we need to update these or create these for configuring the Data Sources.

These Can also be created using Java JMX or any other way but what if we need to parse xml files using PERL.

Perl Provides a couple of ways for parsing xml files.This articles tell you about the XML::Simple and XML::LibXML.

For this article Purpose we use Tomcat Context.xml file and alos Jboss xxx-ds.xml files for reading , Writing and Deleting.

XML::Simple , an easy API to read and write XML. XML::Simple is implemented as an API layer over the XML::Parser module

Now I Need to Find out the How Many Of the Resources are available and are configured in Context.xml file for a Tomcat server.

The Code that I have used for parsing the context.xml file for the above requirement is

$EWS_DS_FILE="$EWS_CFG_DIR/$VIRT_TARGET/conf/context.xml";

my $parser=XML::Simple->new();

my $doc = $parser->XMLin($EWS_DS_FILE,, ForceArray => qr{Resource} ,

keyAttr=> { 'Resource', 'name',KeepRoot => 1 }

);

foreach my $key (keys (%{$doc->{Resource}})) {

print $key;

print "\n";

}

}

Every object of the XML::Simple class exposes two methods, XMLin() and XMLout(). The XMLin() method reads an XML file or string and converts it to a Perl representation; the XMLout() method does the reverse, reading a Perl structure and returning it as an XML document instance

The above XMLin reads the file and stores the result in $doc variable.

ForceArray : This option should be set to true to force nested elements to be represented as arrays even when there is only one

I used “Resource” as Key attribute.

Now the Result that I Obtained

jdbc/com.sample.app.jon.manPoolTXDS2

jdbc/com.sample.app.jon.manPoolTXDS3

jdbc/com.sample.app.jon.manPoolTXDS1

If you need to extract values assigned to elements in XML ,we can use

$POOLNAME="jdbc/" . $POOL_NAME;

$EWS_CFG_DIR=$ENV{JBS_CFGDIR};

$EWS_DS_FILE="$EWS_CFG_DIR/$VIRT_TARGET/conf/context.xml";

my $parser=XML::Simple->new();

my $doc = $parser->XMLin($EWS_DS_FILE,, ForceArray => qr{Resource} ,

keyAttr=> { 'Resource', 'name',KeepRoot => 1 }

);

foreach my $key (keys (%{$doc->{Resource}})) {

if($key eq $POOLNAME) {

print "Name: $key\n";

print "URL: $doc->{Resource}->{$key}->{url}\n";

print "JNDI: $key\n";

print "Factory: $doc->{Resource}->{$key}->{factory}\n";

print "Type: $doc->{Resource}->{$key}->{type}\n";

print "DriverName: $doc->{Resource}->{$key}->{driverClassName}\n";

print "MaxCapacity: $doc->{Resource}->{$key}->{maxActive}\n";

print "InitialCapacity: $doc->{Resource}->{$key}->{initialSize}\n";

print "Max Wait: $doc->{Resource}->{$key}->{maxWait}\n";

print "Time Between Eviction Run: $doc->{Resource}->{$key}->{timeBetweenEvictionRunsMillis}\n";

print "Validation Query: $doc->{Resource}->{$key}->{validationQuery}\n";

print "Remove Abondoned: $doc->{Resource}->{$key}->{removeAbandoned}\n";

print "Test While Idle: $doc->{Resource}->{$key}->{testWhileIdle}\n";

print "UserID: $doc->{Resource}->{$key}->{username}\n";

print "PasswordEncrypted: $doc->{Resource}->{$key}->{password}\n";

}

}

}

Now iam passing the Server name and Pool Name .When I run the Code I get the results as

Name: jdbc/com.sample.app.jon.manPoolTXDS1

URL: xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx

JNDI: jdbc/com.sample.app.jon.manPoolTXDS1

Factory:

Type: javax.sql.DataSource

DriverName: oracle.jdbc.OracleDriver

MaxCapacity: 1

InitialCapacity: 5

Max Wait: 100

Time Between Eviction Run: 300000

Validation Query: SELECT * FROM DUAL

Remove Abondoned: true

Test While Idle: true

UserID: xxxxx

PasswordEncrypted: xxxxx

I can get any details I need.

XML::LibXML : XML::LibXML provides a standard W3C DOM interface. Documents are treated as a tree of nodes and the data those nodes contain are accessed by calling methods on the node objects themselves.

One of the more exciting features of XML::LibXML is that, in addition to the DOM interface, it allows you to select nodes using the XPath language

Iam have used this for Deleting of Nodes in the Context.xml file.We can also use this package which can perform the above things as XML::Simple.

Now if I want to delete the Few Elements I can use

$EWS_CFG_DIR=$ENV{JBS_CFGDIR};

$EWS_DS_FILE="$EWS_CFG_DIR/$VIRT_TARGET/conf/context.xml";

$DS_NAME="jdbc/".$DS_NAME;

my $parser = XML::LibXML->new();

my $tree = $parser->parse_file($EWS_DS_FILE);

my $root = $tree->getDocumentElement;

my @appPolicies = $root->getElementsByTagName('Resource');

foreach my $policy (@appPolicies) {

my $policy_name = $policy->getAttribute('name');

if($policy_name eq $DS_NAME) {

$policy->parentNode()->removeChild($policy);

print "In Equal Policies";

}#Closing Of If PolicY Nmae

}#Closing of App Policies

my $changed = $tree -> toString;

$tree->toFile($EWS_DS_FILE);

DS_NAME is the Name of the Data Source that I Sent as an Argument for deleting.

This is how we can parse Xml files in perl.Iam still working more on these Packages.I will upload more examples of these.

Happy learning :-)

Read More