MapServer - msLoadMap(): Regular expression error. MS_DEFAULT_MAPFILE_PATTERN validation failed - perl

I am trying to use MapServer to load tiles overtop of my google map. When hitting the endpoint, I am getting the error:
msLoadMap(): Regular expression error. MS_DEFAULT_MAPFILE_PATTERN validation failed.
An example of one of the endpoints is:
http://localhost:8080/cgi-bin/tiler?layer=layer_392&map.layer[layer_392].class[0].style[0]=SIZE%203&mode=tile&tilemode=gmap&tile=4%2011%205
The apache config with a ScriptAlias:
# 000-default.conf
<VirtualHost *:80>
ServerAdmin webmaster#localhost
DocumentRoot /var/www/web
LogFormat "{ \"datetime\":\"%{%Y-%m-%d}tT%{%T}t.%{msec_frac}tZ\", \"network.client.ip\":\"%a\", \"http.url_details.host\":\"%V\", \"http.url\":\"%U\", \"http.url_details.queryString\":\"%q\", \"http.method\":\"%m\", \"http.status_code\":\"%>s\", \"http.useragent\":\"%{User-agent}i\", \"http.referer\":\"%{Referer}i\" }," json
CustomLog /dev/stdout json
ScriptAlias /cgi-bin/ /var/www/bin/tile-producer/docker/cron-jobs/
<Directory /var/www>
Options Indexes FollowSymLinks
AllowOverride All
Require all granted
# Setup rewrite rules
RewriteEngine on
RewriteBase "/var/www/web"
</Directory>
</VirtualHost>
mapfile:
#Generated by MapServer Generator MapWindow plug-in
#
# Start of map file
#
MAP
NAME telusdirectory
STATUS ON
EXTENT -180 -90 180 90
SHAPEPATH 'data'
IMAGETYPE png
PROJECTION
"init=epsg:4326"
END
WEB
METADATA
"wms_title" "TELUS Directory Service WMS"
"wms_onlineresource" "http://telus.magicsite.co.uk/cgi-bin/telus?"
"wms_srs" "EPSG:4326"
"tile_map_edge_buffer" "100" # 9 pixel rendering buffer
"http_max_age" "86400"
END
END
SYMBOL
NAME 'square'
TYPE VECTOR
FILLED TRUE
POINTS
0 1
0 0
1 0
1 1
0 1
END
END #SYMBOL
SYMBOL
NAME 'ellipse'
TYPE ELLIPSE
FILLED TRUE
POINTS
1 1
END
END #SYMBOL
IMAGEQUALITY 95
IMAGETYPE png
OUTPUTFORMAT
NAME png
DRIVER 'GD/PNG'
MIMETYPE 'image/png'
EXTENSION 'png'
IMAGEMODE RGBA
TRANSPARENT ON
END
#
# Start of layers definitions
#
#LAYER_DEFS
LAYER
PROJECTION
"init=epsg:4326"
END
NAME layer_392
TYPE point
STATUS ON
DATA 'layer_392.shp'
CLASS
NAME 'layer_392'
STYLE
SYMBOL 'ellipse'
SIZE 2
COLOR 73 22 109
END #STYLE
END #CLASS
TEMPLATE "xxx"
METADATA
"wms_title" "Data layer"
END
END #LAYER
#/LAYER_DEFS
END #MAP
tiler script that is hit on entry:
#!/usr/bin/perl
use CGI qw(:standard);
use URI::Escape;
use File::Basename;
use Cwd 'abs_path';
use v5.10;
my $q = CGI->new;
my #PARAMS = $q->param;
my $NEW_PARAMS;
my ($x, $y, $z) = split(' ', uri_unescape( scalar $q->param('tile') ) );
$NEW_PARAMS = "map="."/var/www/bin/tile-producer/docker/cron-jobs/mapdata"."/telus.map";
if ( #PARAMS ) {
foreach ( #PARAMS ) {
$NEW_PARAMS .= "&$_=" . uri_escape( $q->param( $_ ) );
}
}
$ENV{'QUERY_STRING'} = $NEW_PARAMS;
system("/usr/lib/cgi-bin/mapserv");
Contents of mapdata folder:

So after looking through all of this. My env variable in script that is hit on entry was not getting passed through to CGI. I had to enable it on Apache first and then it started working.

Related

Error 500 when with perl cgi - but not any of the common pitfalls

I have a very tricky to diagnose perl problem, that has been seriously hampering my ability to maintain a perl/cgi website. It usually occurs when editing a script - after a change I get error 500, and then after I revert it it wont work again unless I delete the file and start from scratch, however I currently have a state which it can be reproduced by the following simple two scripts which show just how crazy this bug is:
file1.pl
#! /usr/bin/perl
use CGI::Carp qw(fatalsToBrowser warningsToBrowser);
print "content-type: text/html\n\nIt works";
file2.pl
#! /usr/bin/perl
use CGI::Carp qw(fatalsToBrowser warningsToBrowser);
print "content-type: text/html\n\nIt works";
(Ie... they're identical)
server.com/cgi-bin/file1.pl works
server.com/cgi-bin/file2.pl results in error 500
Both files have the same size and md5 hash.
Both have the same permissions (755) and the same owner and group.
Both are in the correct folder (hosting supplied cgi-bin).
Both were uploaded in text mode.
Both work with local perl interpreters.
If i rename file1 -> file3, file2 -> file1, and file3->file2, (ie swapping both files), now file2.pl works and file1.pl doesn't. So my guess is some state is attached to the files themselves.
If i edit the files in filezilla and re-upload (eg add some whitespace after a semicolon), same behaviour occurs with the re-uploaded files.
My error 500 page is set to auto-retry using a meta refresh (in case of out memory errors, etc), and it doesn't go away after countless refreshes. It doesn't seem to matter which ones is accessed first.
I do not have access to the http error_log on this hosting so do not know the reason for the failure. The error also occurs without the "use error messages to browser" diagnostic line.
Can anyone give me a hint as to what this could be and help me fix it?
What you describe can be either caused by some problem on your hosting provider side (some bad caching, or transparent proxies, or any other magic), or—and that is what I think it is—still caused by wrong file permissions or line breaks, even if your file manager reports that everything is good.
If I'm reading your description correctly you basically
can put a script and it will work, but
cannot edit it as it will stop working after that.
As you don't have shell access, just put the following small script to the same directory and run it (hope it will run as you are not going to edit it):
#!/usr/bin/perl
use strict;
use warnings;
print "Content-Type: text/plain\n\n";
opendir( my $dirh, "." );
my #files = grep { -f $_; } readdir $dirh;
closedir $dirh;
foreach my $file (#files) {
my #stat = stat $file;
my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev,
$size, $atime, $mtime, $ctime, $blksize, $blocks
) = stat($file);
my $octmode = sprintf "%04o", $mode & 07777;
print "$file\tmode=$octmode\tuid=$uid\tgid=$gid\tsize=$size\t";
if ( -r $file ) {
open( my $fh, $file );
my $firstline = <$fh>;
print $firstline =~ /\r\n/ ? "crlf\n" : "lf\n";
close $fh;
} else {
print "can't read\n";
}
}
It will show the real permissions, linebreaks, and size of the files—those taken from the server's filesystem, not which your FTP client shows.
Maybe it's worth adding MD5 or SHA1 hash calculation to this script but not sure if you have Digest::MD5 or Digest::SHA1 available.
If you see the same output for test1.pl and test2.pl, just go ahead and contact your hosting provider's support.
My guess: the files don't use the same newline convention.
You can check this (in a Unix shell) using the file command.
Not being able to inspect the errorlog is a big headache.
Nevertheless, I suspect that the cause is still most likely line endings. I would upload a script to examine all of your files like the following:
#!/usr/bin/env perl
use strict;
use warnings;
use autodie;
use CGI qw(header);
use CGI::Carp qw(fatalsToBrowser warningsToBrowser);
use File::stat;
print header('text/plain');
my $fmt = "%-15s %4s %4s %4s %7s %4s %4s\n";
printf $fmt, qw(File mode uid gid size lf crlf);
printf $fmt, map { '-' x $_ } $fmt =~ /(\d+)/g;
opendir my $dh, '.';
while ( my $file = readdir $dh ) {
next unless -f $file;
my $stat = stat $file;
my %chars;
my $data = do { local ( #ARGV, $/ ) = $file; <> };
$chars{$1}++ while $data =~ /(\R)/g;
printf $fmt, $file, sprintf( "%04o", $stat->mode & 07777 ), $stat->uid,
$stat->gid, $stat->size, map { $_ // 0 } #chars{ "\n", "\r\n" };
}
Outputs:
Content-Type: text/plain; charset=ISO-8859-1
File mode uid gid size lf crlf
--------------- ---- ---- ---- ------- ---- ----
env.cgi 0775 0 0 266 25 0
le.pl 0775 501 0 696 28 0
lineendings.pl 0755 501 0 516 30 0
mywiki.pl 0755 501 0 226947 0 6666
test.cgi 0755 0 0 2071 65 0
wiki.pl 0755 0 0 219231 6494 0
For additional testing, I would recommend executing each of the scripts using system and inspecting the error conditions if there are any.
I have had the same problem, got help from user BOC as below:
"You may have problem with encoding of characters. Some editors replace some characters by very close characters when you save files (for example " by “). Try changing editor (notepad++ works well on windows). – BOC"
I downloaded and used Notepad++ instead of Notepad and Winword; It works now for me.

New to Perl - Parsing file and replacing pattern with dynamic values

I am very new to Perl and i am currently trying to convert a bash script to perl.
My script is used to convert nmon files (AIX / Linux perf monitoring tool), it takes nmon files present in a directory, grep and redirect the specific section to a temp file, grep and redirect the associated timestamp to aother file.
Then, it parses data into a final csv file that will be indexed by a a third tool to be exploited.
A sample NMON data looks like:
TOP,%CPU Utilisation
TOP,+PID,Time,%CPU,%Usr,%Sys,Threads,Size,ResText,ResData,CharIO,%RAM,Paging,Command,WLMclass
TOP,5165226,T0002,10.93,9.98,0.95,1,54852,4232,51220,311014,0.755,1264,PatrolAgent,Unclassified
TOP,5365876,T0002,1.48,0.81,0.67,135,85032,132,84928,38165,1.159,0,db2sysc,Unclassified
TOP,5460056,T0002,0.32,0.27,0.05,1,5060,616,4704,1719,0.072,0,db2kmchan64.v9,Unclassified
The field "Time" (Seen as T0002 and really called ZZZZ in NMON) is a specific NMON timestamp, the real value of this timestamp is present later (in a dedicated section) in the NMON file and looks like:
ZZZZ,T0001,00:09:55,01-JAN-2014
ZZZZ,T0002,00:13:55,01-JAN-2014
ZZZZ,T0003,00:17:55,01-JAN-2014
ZZZZ,T0004,00:21:55,01-JAN-2014
ZZZZ,T0005,00:25:55,01-JAN-2014
The NMON format is very specific and can't be exploited directly without being parsed, the timestamp has to be associated with the corresponding value. (A NMON file is almost like a concatenation of numerous different csv files with each a different format, different fileds and so on.)
I wrote the following bash script to parse the section i'm interested in (The "TOP" section which represents top process cpu, mem, io stats per host)
#!/bin/bash
# set -x
################################################################
# INFORMATION
################################################################
# nmon2csv_TOP.sh
# Convert TOP section of nmon files to csv
# CAUTION: This script is expected to be launched by the main workflow
# $DST and DST_CONVERTED_TOP are being exported by it, if not this script will exit at launch time
################################################################
# VARS
################################################################
# Location of NMON files
NMON_DIR=${DST}
# Location of generated files
OUTPUT_DIR=${DST_CONVERTED_TOP}
# Temp files
rawdatafile=/tmp/temp_rawdata.$$.temp
timestampfile=/tmp/temp_timestamp.$$.temp
# Main Output file
finalfile=${DST_CONVERTED_TOP}/NMON_TOP_processed_at_date_`date '+%F'`.csv
###########################
# BEGIN OF WORK
###########################
# Verify exported var are not null
if [ -z ${NMON_DIR} ]; then
echo -e "\nERROR: Var NMON_DIR is null!\n" && exit 1
elif [ -z ${OUTPUT_DIR} ]; then
echo -e "\nERROR: Var OUTPUT_DIR is null!\n" && exit 1
fi
# Check if temp and output files already exists
if [ -s ${rawdatafile} ]; then
rm -f ${rawdatafile}
elif [ -s ${timestampfile} ]; then
rm -f ${timestampfile}
elif [ -s ${finalfile} ]; then
rm -f ${finalfile}
fi
# Get current location
PWD=`pwd`
# Go to NMON files location
cd ${NMON_DIR}
# For each NMON file present:
# To restrict to only PROD env: `ls *.nmon | grep -E -i 'sp|gp|ge'`
for NMON_FILE in `ls *.nmon | grep -E -i 'sp|gp|ge'`; do
# Set Hostname identification
serialnum=`grep 'AAA,SerialNumber,' ${NMON_FILE} | awk -F, '{print $3}' OFS=, | tr [:lower:] [:upper:]`
hostname=`grep 'AAA,host,' ${NMON_FILE} | awk -F, '{print $3}' OFS=, | tr [:lower:] [:upper:]`
# Grep and redirect TOP Section
grep 'TOP' ${NMON_FILE} | grep -v 'AAA,version,TOPAS-NMON' | grep -v 'TOP,%CPU Utilisation' > ${rawdatafile}
# Grep and redirect associated timestamps (ZZZZ)
grep 'ZZZZ' ${NMON_FILE}> ${timestampfile}
# Begin of work
while IFS=, read TOP PID Time Pct_CPU Pct_Usr Pct_Sys Threads Size ResText ResData CharIO Pct_RAM Paging Command WLMclass
do
timestamp=`grep ${Time} ${timestampfile} | awk -F, '{print $4 " "$3}' OFS=,`
echo ${serialnum},${hostname},${timestamp},${Time},${PID},${Pct_CPU},${Pct_Usr},${Pct_Sys},${Threads},${Size},${ResText},${ResData},${CharIO},${Pct_RAM},${Paging},${Command},${WLMclass} \
| grep -v '+PID,%CPU,%Usr,%Sys,Threads,Size,ResText,ResData,CharIO,%RAM,Paging,Command,WLMclass' >> ${finalfile}
done < ${rawdatafile}
echo -e "INFO: Done for Serialnum: ${serialnum} Hostname: ${hostname}"
done
# Go back to initial location
cd ${PWD}
###########################
# END OF WORK
###########################
This works as wanted and generate a main csv file (you'll see in the code that i voluntary don't keep the csv header in the file) wich is a concatenation of all parsed hosts.
But, i have a very large amount of host to treat each day (around 3000 hosts), with this current code and in worst cases, it can takes a few minutes to generate data for 1 host, multiplicated per number of hosts minutes becomes easily hours...
So, this code is really not performer enough to deal with such amount of data
10 hosts represents around 200.000 lines, which represents finally around 20 MB of csv file.
That's not that much, but i think that a shell script is probably not the better choice to manage such a process...
I guess that perl shall be much better at this task (even if the shell script could probably be improved), but my knowledge in perl is (currently) very poor, this is why i ask your help... I think that code should be quite simple to do in perl but i can't get it to work as for now...
One guy used to develop a perl script to manage NMON files and convert them to sql files (to dump these data into a database), i staged it to use its feature and with the help of some shell scripts i manage the sql files to get my final csv files.
But the TOP section was not integrated into that perl script and can't be used to that without being redeveloped.
The code in question:
#!/usr/bin/perl
# Program name: nmon2mysql.pl
# Purpose - convert nmon.csv file(s) into mysql insert file
# Author - Bruce Spencer
# Disclaimer: this provided "as is".
# Date - March 2007
#
$nmon2mysql_ver="1.0. March 2007";
use Time::Local;
#################################################
## Your Customizations Go Here ##
#################################################
# Source directory for nmon csv files
my $NMON_DIR=$ENV{DST_TMP};
my $OUTPUT_DIR=$ENV{DST_CONVERTED_CPU_ALL};
# End "Your Customizations Go Here".
# You're on your own, if you change anything beyond this line :-)
####################################################################
############# Main Program ############
####################################################################
# Initialize common variables
&initialize;
# Process all "nmon" files located in the $NMON_DIR
# #nmon_files=`ls $NMON_DIR/*.nmon $NMON_DIR/*.csv`;
#nmon_files=`ls $NMON_DIR/*.nmon`;
if (#nmon_files eq 0 ) { die ("No \*.nmon or csv files found in $NMON_DIR\n"); }
#nmon_files=sort(#nmon_files);
chomp(#nmon_files);
foreach $FILENAME ( #nmon_files ) {
#cols= split(/\//,$FILENAME);
$BASEFILENAME= $cols[#cols-1];
unless (open(INSERT, ">$OUTPUT_DIR/$BASEFILENAME.sql")) {
die("Can not open /$OUTPUT_DIR/$BASEFILENAME.sql\n");
}
print INSERT ("# nmon version: $NMONVER\n");
print INSERT ("# AIX version: $AIXVER\n");
print INSERT ("use nmon;\n");
$start=time();
#now=localtime($start);
$now=join(":",#now[2,1,0]);
print ("$now: Begin processing file = $FILENAME\n");
# Parse nmon file, skip if unsuccessful
if (( &get_nmon_data ) gt 0 ) { next; }
$now=time();
$now=$now-$start;
print ("\t$now: Finished get_nmon_data\n");
# Static variables (number of fields always the same)
##static_vars=("LPAR","CPU_ALL","FILE","MEM","PAGE","MEMNEW","MEMUSE","PROC");
##static_vars=("LPAR","CPU_ALL","FILE","MEM","PAGE","MEMNEW","MEMUSE");
#static_vars=("CPU_ALL");
foreach $key (#static_vars) {
&mk_mysql_insert_static($key);;
$now=time();
$now=$now-$start;
print ("\t$now: Finished $key\n");
} # end foreach
# Dynamic variables (variable number of fields)
##dynamic_vars=("DISKBSIZE","DISKBUSY","DISKREAD","DISKWRITE","DISKXFER","ESSREAD","ESSWRITE","ESSXFER","IOADAPT","NETERROR","NET","NETPACKET");
#dynamic_vars=("");
foreach $key (#dynamic_vars) {
&mk_mysql_insert_variable($key);;
$now=time();
$now=$now-$start;
print ("\t$now: Finished $key\n");
}
close(INSERT);
# system("gzip","$FILENAME");
}
exit(0);
############################################
############# Subroutines ############
############################################
##################################################################
## Extract CPU_ALL data for Static fields
##################################################################
sub mk_mysql_insert_static {
my($nmon_var)=#_;
my $table=lc($nmon_var);
my #rawdata;
my $x;
my #cols;
my $comma;
my $TS;
my $n;
#rawdata=grep(/^$nmon_var,/, #nmon);
if (#rawdata < 1) { return(1); }
#rawdata=sort(#rawdata);
#cols=split(/,/,$rawdata[0]);
$x=join(",",#cols[2..#cols-1]);
$x=~ s/\%/_PCT/g;
$x=~ s/\(MB\)/_MB/g;
$x=~ s/-/_/g;
$x=~ s/ /_/g;
$x=~ s/__/_/g;
$x=~ s/,_/,/g;
$x=~ s/_,/,/g;
$x=~ s/^_//;
$x=~ s/_$//;
print INSERT (qq|insert into $table (serialnum,hostname,mode,nmonver,time,ZZZZ,$x) values\n| );
$comma="";
$n=#cols;
$n=$n-1; # number of columns -1
for($i=1;$i<#rawdata;$i++){
$TS=$UTC_START + $INTERVAL*($i);
#cols=split(/,/,$rawdata[$i]);
$x=join(",",#cols[2..$n]);
$x=~ s/,,/,-1,/g; # replace missing data ",," with a ",-1,"
print INSERT (qq|$comma("$SN","$HOSTNAME","$MODE","$NMONVER",$TS,"$DATETIME{#cols[1]}",$x)| );
$comma=",\n";
}
print INSERT (qq|;\n\n|);
} # end mk_mysql_insert
##################################################################
## Extract CPU_ALL data for variable fields
##################################################################
sub mk_mysql_insert_variable {
my($nmon_var)=#_;
my $table=lc($nmon_var);
my #rawdata;
my $x;
my $j;
my #cols;
my $comma;
my $TS;
my $n;
my #devices;
#rawdata=grep(/^$nmon_var,/, #nmon);
if ( #rawdata < 1) { return; }
#rawdata=sort(#rawdata);
$rawdata[0]=~ s/\%/_PCT/g;
$rawdata[0]=~ s/\(/_/g;
$rawdata[0]=~ s/\)/_/g;
$rawdata[0]=~ s/ /_/g;
$rawdata[0]=~ s/__/_/g;
$rawdata[0]=~ s/,_/,/g;
#devices=split(/,/,$rawdata[0]);
print INSERT (qq|insert into $table (serialnum,hostname,time,ZZZZ,device,value) values\n| );
$n=#rawdata;
$n--;
for($i=1;$i<#rawdata;$i++){
$TS=$UTC_START + $INTERVAL*($i);
$rawdata[$i]=~ s/,$//;
#cols=split(/,/,$rawdata[$i]);
print INSERT (qq|\n("$SN","$HOSTNAME",$TS,"$DATETIME{$cols[1]}","$devices[2]",$cols[2])| );
for($j=3;$j<#cols;$j++){
print INSERT (qq|,\n("$SN","$HOSTNAME",$TS,"$DATETIME{$cols[1]}","$devices[$j]",$cols[$j])| );
}
if ($i < $n) { print INSERT (","); }
}
print INSERT (qq|;\n\n|);
} # end mk_mysql_insert_variable
########################################################
### Get an nmon setting from csv file ###
### finds first occurance of $search ###
### Return the selected column...$return_col ###
### Syntax: ###
### get_setting($search,$col_to_return,$separator)##
########################################################
sub get_setting {
my $i;
my $value="-1";
my ($search,$col,$separator)= #_; # search text, $col, $separator
for ($i=0; $i<#nmon; $i++){
if ($nmon[$i] =~ /$search/ ) {
$value=(split(/$separator/,$nmon[$i]))[$col];
$value =~ s/["']*//g; #remove non alphanum characters
return($value);
} # end if
} # end for
return($value);
} # end get_setting
#####################
## Clean up ##
#####################
sub clean_up_line {
# remove characters not compatible with nmon variable
# Max rrdtool variable length is 19 chars
# Variable can not contain special characters (% - () )
my ($x)=#_;
# print ("clean_up, before: $i\t$nmon[$i]\n");
$x =~ s/\%/Pct/g;
# $x =~ s/\W*//g;
$x =~ s/\/s/ps/g; # /s - ps
$x =~ s/\//s/g; # / - s
$x =~ s/\(/_/g;
$x =~ s/\)/_/g;
$x =~ s/ /_/g;
$x =~ s/-/_/g;
$x =~ s/_KBps//g;
$x =~ s/_tps//g;
$x =~ s/[:,]*\s*$//;
$retval=$x;
} # end clean up
##########################################
## Extract headings from nmon csv file ##
##########################################
sub initialize {
%MONTH2NUMBER = ("jan", 1, "feb",2, "mar",3, "apr",4, "may",5, "jun",6, "jul",7, "aug",8, "sep",9, "oct",10, "nov",11, "dec",12 );
#MONTH2ALPHA = ( "junk","jan", "feb", "mar", "apr", "may", "jun", "jul", "aug", "sep", "oct", "nov", "dec" );
} # end initialize
# Get data from nmon file, extract specific data fields (hostname, date, ...)
sub get_nmon_data {
my $key;
my $x;
my $category;
my %toc;
my #cols;
# Read nmon file
unless (open(FILE, $FILENAME)) { return(1); }
#nmon=<FILE>; # input entire file
close(FILE);
chomp(#nmon);
# Cleanup nmon data remove trainig commas and colons
for($i=0; $i<#nmon;$i++ ) {
$nmon[$i] =~ s/[:,]*\s*$//;
}
# Get nmon/server settings (search string, return column, delimiter)
$AIXVER =&get_setting("AIX",2,",");
$DATE =&get_setting("date",2,",");
$HOSTNAME =&get_setting("host",2,",");
$INTERVAL =&get_setting("interval",2,","); # nmon sampling interval
$MEMORY =&get_setting(qq|lsconf,"Good Memory Size:|,1,":");
$MODEL =&get_setting("modelname",3,'\s+');
$NMONVER =&get_setting("version",2,",");
$SNAPSHOTS =&get_setting("snapshots",2,","); # number of readings
$STARTTIME =&get_setting("AAA,time",2,",");
($HR, $MIN)=split(/\:/,$STARTTIME);
if ($AIXVER eq "-1") {
$SN=$HOSTNAME; # Probably a Linux host
} else {
$SN =&get_setting("systemid",4,",");
$SN =(split(/\s+/,$SN))[0]; # "systemid IBM,SN ..."
}
$TYPE =&get_setting("^BBBP.*Type",3,",");
if ( $TYPE =~ /Shared/ ) { $TYPE="SPLPAR"; } else { $TYPE="Dedicated"; }
$MODE =&get_setting("^BBBP.*Mode",3,",");
$MODE =(split(/: /, $MODE))[1];
# $MODE =~s/\"//g;
# Calculate UTC time (seconds since 1970)
# NMON V9 dd/mm/yy
# NMON V10+ dd-MMM-yyyy
if ( $DATE =~ /[a-zA-Z]/ ) { # Alpha = assume dd-MMM-yyyy date format
($DAY, $MMM, $YR)=split(/\-/,$DATE);
$MMM=lc($MMM);
$MON=$MONTH2NUMBER{$MMM};
} else {
($DAY, $MON, $YR)=split(/\//,$DATE);
$YR=$YR + 2000;
$MMM=$MONTH2ALPHA[$MON];
} # end if
## Calculate UTC time (seconds since 1970). Required format for the rrdtool.
## timelocal format
## day=1-31
## month=0-11
## year = x -1900 (time since 1900) (seems to work with either 2006 or 106)
$m=$MON - 1; # jan=0, feb=2, ...
$UTC_START=timelocal(0,$MIN,$HR,$DAY,$m,$YR);
$UTC_END=$UTC_START + $INTERVAL * $SNAPSHOTS;
#ZZZZ=grep(/^ZZZZ,/,#nmon);
for ($i=0;$i<#ZZZZ;$i++){
#cols=split(/,/,$ZZZZ[$i]);
($DAY,$MON,$YR)=split(/-/,$cols[3]);
$MON=lc($MON);
$MON="00" . $MONTH2NUMBER{$MON};
$MON=substr($MON,-2,2);
$ZZZZ[$i]="$YR-$MON-$DAY $cols[2]";
$DATETIME{$cols[1]}="$YR-$MON-$DAY $cols[2]";
} # end ZZZZ
return(0);
} # end get_nmon_data
It almost (i say almost because with recent NMON versions it can sometimes have some issue when no data present) does the job, and it does it much much faster that would do my shell script if i would use it for these section
This is why i think perl shall be a perfect solution.
Off course, i don't ask anyone to convert my shell script into something final in perl, but at least to give me to right direction :-)
I really thank anyone in advance for your help !
Normally i am strongly opposed to questions like this but our production systems are down and until they are fixed i do not really have all that much to do...
Here is some code that might get you started. Please consider it pseudo code as it is completely untested and probably won't even compile (i always forget some parantheses or semicolons and as i said, the actual machines that can run code are unreachable) but i commented a lot and hopefully you will be able to modify it to your actual needs and get it to run.
use strict;
use warnings;
open INFILE, "<", "path/to/file.nmon"; # Open the file.
my #topLines; # Initialize variables.
my %timestamps;
while <INFILE> # This will walk over all the lines of the infile.
{ # Storing the current line in $_.
chomp $_; # Remove newline at the end.
if ($_ =~ m/^TOP/) # If the line starts with TOP...
{
push #topLines, $_; # ...store it in the array for later use.
}
elsif ($_ =~ m/^ZZZZ/) # If it is in the ZZZZ section...
{
my #fields = split ',', $_; # ...split the line at commas...
my $timestamp = join ",", $fields(2), $fields(3); # ...join the timestamp into a string as you wish...
$timestamps{$fields(1)} = $timestamp; # ...and store it in the hash with the Twhatever thing as key.
}
# This iteration could certainly be improved with more knowledge
# of how the file looks. For example the search could be cancelled
# after the ZZZZ section if the file is still long.
}
close INFILE;
open OUTFILE, ">", "path/to/output.csv"; # Open the file you want your output in.
foreach (#topLines) # Iterate through all elements of the array.
{ # Once again storing the current value in $_.
my #fields = split ',', $_; # Probably not necessary, depending on how output should be formated.
my $outstring = join ',', $fields(0), $fields(1), $timestamps{$fields(2)}; # And whatever other fields you care for.
print OUTFILE $outstring, "\n"; # Print.
}
close OUTFILE;
print "Done.\n";

Limiting log size with log4perl

I want to limit the size of log files created with log4perl. I don't want my log file to grow to more than about 100mb; I only need the last 100mb (or thereabouts) of data. Ideally, it would truncate earlier data and only keep the last bits. I'm aware of the Log::Dispatch::FileRotate module, but that doesn't quite meet my requirements, as I don't want multiple log files.
Is this possible?
Full code, including inline config, below (minus the use statements):
my $log_conf = q/
log4perl.category = DEBUG, Logfile
log4perl.appender.Logfile = Log::Dispatch::FileRotate
log4perl.appender.Logfile.filename = sub { return get_log_fn(); }
log4perl.appender.Logfile.mode = truncate
log4perl.appender.Logfile.autoflush = 1
log4perl.appender.Logfile.size = 104857600
log4perl.appender.Logfile.layout = Log::Log4perl::Layout::PatternLayout
log4perl.appender.Logfile.layout.ConversionPattern = %d %P %M(%L) %p %m %n
/;
Log::Log4perl::init( \$log_conf );
my $logger = Log::Log4perl::get_logger();
INFO "Starting $0";
my $upper = 100000000;
for(my $i=0;$i < $upper;$i++) {
DEBUG $i;
}
sub get_log_fn
{
use File::Basename;
return sprintf "%s.log", basename( $0, '.pl' );
}
I just read a bit and did an experiment. It seems if you leave off the max attribute, keep the size attribute, and use the truncate attribute rather than append while using Log::Dispatch::FileRotate you can get what you want:
#!/usr/bin/env perl
use Modern::Perl;
use Log::Log4perl;
Log::Log4perl::init('./log4perl.conf');
my $logger = Log::Log4perl->get_logger('LOG1');
for my $num ( 1..1000 ) {
$logger->debug($num);
}
$logger->debug('blah');
With the associated config file:
###############################################################################
# Log::Log4perl Conf #
###############################################################################
log4perl.rootLogger = DEBUG, LOG1
log4perl.appender.LOG1 = Log::Dispatch::FileRotate
log4perl.appender.LOG1.filename = ./mylog.log
log4perl.appender.LOG1.mode = truncate
log4perl.appender.LOG1.autoflush = 1
log4perl.appender.LOG1.size = 1024
#log4perl.appender.LOG1.max = 5
log4perl.appender.LOG1.layout = Log::Log4perl::Layout::PatternLayout
log4perl.appender.LOG1.layout.ConversionPattern = %d %p %m %n
That leaves me with a 130 byte mylog.log with 4 lines in it:
2012/07/25 08:23:14 DEBUG 998
2012/07/25 08:23:14 DEBUG 999
2012/07/25 08:23:14 DEBUG 1000
2012/07/25 08:23:14 DEBUG blah
UPDATE
It looks like FileRotate will always make at least a .1 file even when max is set to 0.
If that absolutely won't work from you, you'll need to write your own apender.
I had the same problem and found this module:
http://search.cpan.org/dist/Log-Log4perl-Appender-File-FixedSize/lib/Log/Log4perl/Appender/File/FixedSize.pm
Perhaps two years late, but I figured other people who landed here might benefit from this

IRC Client - channel latitude and longitude details

Is there a way to retrieve latitude and longitude details of IRC channel so that I can locate the same on Map.
Thanks.
To get the locations of the people in the channel, you could simply look at their hostname - names on IRC are made up of a nickname, a username, and a hostname in the format nickname!username#hostname.
The hostname could be one of three things - an IP address, a DNS name, or a "cloak". You could use a DNS client to convert the hostname into an IP address, and then with the IP addresses you could use an IP geolocation tool (such as ipinfodb.com which has a nice free API), and retrieve the latitude and longtitude of each user.
If the hostname is a cloak, and the format of this varies between networks, then there's no way (unless you have advanced privileges on the IRC network) to get the real IP/hostname (and hence location) of that user.
Radoslaw Zielinski (radek at pld-linux dot org) wrote a Perl script for geolocation of nicknames in the XChat IRC client:
I wrote a simple plugin to look up the IP address in the Maxmind GeoIP lookup database, you can find it here: xchat-geo.pl. See “perldoc xchat-geo.pl” for the installation instructions.
Usage:
/geo some_nickname
Output:
[17:33] ==> some_nickname | US San Francisco CA 37.7525 -122.3194 n=somenick#some.host
Original blog post: www.radek.cc/2009/09/06/irc-xchat-geolocation-plugin/
It requires that you install:
Perl
one of the Maxmind GeoIP databases (some are free)
the Maxmind Geo::IP module (its API for Perl)
XChat with a Perl scripting interface plugin
xchat-geo.pl, retrieved 2012-03-06:
#!/usr/bin/perl -w
use strict;
use Geo::IP ();
our $VERSION = '0.04';
=head1 NAME
xchat-geo.pl - geolocation plugin for xchat
=head1 SYNOPSIS
perl -MCPAN -e 'install Geo::IP'
chmod +x xchat-geo.pl
mv xchat-geo.pl ~/.xchat/
# in xchat
/unload .xchat/xchat-geo.pl
/load .xchat/xchat-geo.pl
/geo some-nickname
=head1 DESCRIPTION
Usage:
/geo some_nickname
[17:33] ==> some_nickname | US San Francisco CA 37.7525 -122.3194
n=somenick#some.host
Provides a single C</geo> command, which attempts to lookup the IP address in
the maxmind GeoIP database.
Requires the Geo::IP module to be installed, along with the GeoIP City (or its
free GeoLite counterpart); see L<http://www.maxmind.com/app/ip-location> and
L<http://www.maxmind.com/app/geolitecity>.
On my machine, the installed databases look like this:
$ ls -l /usr/share/GeoIP
lrwxrwxrwx 1 root root 15 Sep 6 16:54 GeoIPCity.dat -> GeoLiteCity.dat
-rw-r--r-- 1 root root 877738 Sep 6 16:25 GeoIP.dat
-rw-r--r-- 1 root root 27711885 Sep 6 16:31 GeoLiteCity.dat
Released 2009-09-06
=head1 AUTHOR
Radoslaw Zielinski E<lt>radek#pld-linux.orgE<gt>
http://radek.cc/2009/09/06/irc-xchat-geolocation-plugin/
=head1 LICENSE
GPL v3
=cut
our $geo = Geo::IP->open_type( Geo::IP::GEOIP_CITY_EDITION_REV1 ) # Geo::IP::GEOIP_STANDARD
or die "can't load the GeoIP database";
Xchat::print('xchat geo starting');
Xchat::register( 'xchat geo', $VERSION, 'geo location for xchat', \&unload );
Xchat::hook_print( 'Join', \&Join, );
Xchat::hook_command( 'geo', sub { geo(#_); Xchat::EAT_ALL; }, );
# for debugging / plugin development
#Xchat::hook_command( 'xev', sub { eval $_[1][0]; Xchat::EAT_ALL; }, );
sub Join {
my ( $user, $channel, $host ) = #{ $_[0] };
my $r = record_from_ihost($host);
Xchat::printf( "-\x0311->\x03\t\x02%s \x0f\x0314(\x0311%s\x0314) \x03has joined %s [\x0308%s\x0f]",
$user, $host, $channel,
$r && ref $r
? join( ', ', map { defined $_ ? $_ : '' } $r->country_code, $r->city, $r->region, $r->postal_code, )
: '' );
return Xchat::EAT_XCHAT;
}
# /geo some_nickname
sub geo {
my ($cmd) = #_;
defined $cmd->[1] && length $cmd->[1]
or return Xchat::print('nick?');
my $user = Xchat::user_info( $cmd->[1] )
or return Xchat::print("no such nick $cmd->[1]");
my $r = record_from_ihost( $user->{host} )
or return;
return ref $r
? Xchat::print(
' ==> ' . join "\t", $user->{nick}, $r->country_code, $r->city, $r->region,
$r->latitude, $r->longitude, $r->postal_code, $user->{host}
)
: Xchat::print($r);
}
# input: nick and hostname, as reported by xchat
# - n=user#hostname
# - n=user#IP.address
# - n=user#some/freenode/cloak (useless)
# output: a string with error message or a Geo::IP record
sub record_from_ihost {
my $ihost = shift
or return;
( my $nick = $ihost ) =~ s/^.=|\#.*//g;
$ihost =~ /^ [^#]* \# (?: ((?:\d{1,3}\.){3}\.\d{1,3}) | ([a-zA-Z\d_-]+\.[.a-zA-Z\d_-]+) ) (?: \s.* )? $/x
or return "no useful host for <$nick> -- $ihost";
my $r = ( $1 ? $geo->record_by_ip($1) : $geo->record_by_name($2) )
or return "no useful geo info for <$nick> -- $ihost " . ( $1 ? "1: $1" : "2: $2" );
return $r;
}
sub unload {
undef $geo;
Xchat::print('xchat geo exiting');
}
# vim: ts=4 sw=4 noet

How can I remove relative path components but leave symlinks alone in Perl?

I need to get Perl to remove relative path components from a Linux path. I've found a couple of functions that almost do what I want, but:
File::Spec->rel2abs does too little. It does not resolve ".." into a directory properly.
Cwd::realpath does too much. It resolves all symbolic links in the path, which I do not want.
Perhaps the best way to illustrate how I want this function to behave is to post a bash log where FixPath is a hypothetical command that gives the desired output:
'/tmp/test'$ mkdir -p a/b/c1 a/b/c2
'/tmp/test'$ cd a
'/tmp/test/a'$ ln -s b link
'/tmp/test/a'$ ls
b link
'/tmp/test/a'$ cd b
'/tmp/test/a/b'$ ls
c1 c2
'/tmp/test/a/b'$ FixPath . # rel2abs works here
===> /tmp/test/a/b
'/tmp/test/a/b'$ FixPath .. # realpath works here
===> /tmp/test/a
'/tmp/test/a/b'$ FixPath c1 # rel2abs works here
===> /tmp/test/a/b/c1
'/tmp/test/a/b'$ FixPath ../b # realpath works here
===> /tmp/test/a/b
'/tmp/test/a/b'$ FixPath ../link/c1 # neither one works here
===> /tmp/test/a/link/c1
'/tmp/test/a/b'$ FixPath missing # should work for nonexistent files
===> /tmp/test/a/b/missing
Alright, here is what I came up with:
sub mangle_path {
# NOT PORTABLE
# Attempt to remove relative components from a path - can return
# incorrect results for paths like ../some_symlink/.. etc.
my $path = shift;
$path = getcwd . "/$path" if '/' ne substr $path, 0, 1;
my #dirs = ();
for(split '/', $path) {
pop #dirs, next if $_ eq '..';
push #dirs, $_ unless $_ eq '.' or $_ eq '';
}
return '/' . join '/', #dirs;
}
I know this is possibly insecure and invalid, but any input to this routine will come from me on the command line, and it solves a couple of tricky use cases for me.