Category: Perl

Perl code snippets and solutions

Categories
Apache Linux Perl

How to automate LetsEncrypt

A new service is born: Let’s Encrypt. It offers free SSL certificates that you can use for web servers, email servers or whatever service you want to secure with TLS. This blog post presents my strategy to automate certificate creation and renewal. Please, install Let’s Encrypt on your web server box before you start to follow the presented strategy.

The key to success is to have Let’s Encrypt running without any further interaction. I use webroot authentication – which allows me to leave the productive web service up and running while the certificates are being issued or renewed. Therefore, I created a file named “myserver.ini” in folder /etc/letsencrypt. This configuration file contains all details that are required for the certification process;

1
2
3
4
5
6
7
8

rsa-key-size = 4096
authenticator = webroot
webroot-path = /path/to/webroot/
server = https://acme-v01.api.letsencrypt.org/directory
renew-by-default = True
agree-tos
email = <my-email-address>
domains = domain1.com, domain2.com

The second component of my strategy is the central piece: a script called “renewCertificates.pl”:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43

#!/usr/bin/perl
 
my $DOMAINS = {
    'myserver' => {
        'configFile' => '/etc/letsencrypt/myserver.ini',
        'leSubDir'   => 'domain1.com',
        'certDir'    => '/var/www/domain1.com/certs',
    },
};
 
my $domain;
my $renewed = 0;
chdir ('/usr/local/letsencrypt');
foreach $domain (keys(%{$DOMAINS})) {
    print "INFO  - $domain - START\n";
    my $cmd = '/usr/local/scripts/checkCertExpiry.sh 30 '.$DOMAINS->{$domain}->{'certDir'}.'/cert.pem >/dev/null';
    my $rc = system($cmd);
    if ($rc) {
        $cmd = './letsencrypt-auto certonly --config '.$DOMAINS->{$domain}->{'configFile'}.' --renew-by-default';
        $rc = system($cmd);
        if (!$rc) {
            $cmd = 'cp /etc/letsencrypt/live/'.$DOMAINS->{$domain}->{'leSubDir'}.'/* '.$DOMAINS->{$domain}->{'certDir'}.'/';
            $rc = system($cmd);
            if ($rc) {
                print "ERROR - $domain - Cannot deploy\n";
            } else {
                print "INFO  - $domain - Deployed\n";
                $renewed = 1;
            }
        } else {
            print "ERROR - $domain - Cannot generate certificates\n";
        }
    } else {
        print "INFO  - $domain - Certificate does not expire within 30 days\n";
    }
    print "INFO  - $domain - END");
}
 
if ($renewed) {
   system("/etc/init.d/apache2 reload");
}
 
exit 0;

This scripts allows renewal of multiple certificates by supporting multiple configurations. Lines 3-9 describe these configurations. leSubDir (line 6) is the sub directory that Let’s Encrypt creates in the certification process. It is the name of the first domain specified in the configuration file, here: domain1.com. certDir (line 7) is the target path where the certificates will be deployed to.

A second script supports this procedure by telling whether a certificate will expire within a certain number of days (see line 16 above):

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20

#!/bin/bash
 
# First parameter specifies if certificate expire in the next X days
DAYS=$1
 
target=$2
if [ ! -f "$target" ]; then
    echo "Certificate does not exist (RC=2)"
    exit 2;
fi
 
openssl x509 -checkend $(( 86400 * $DAYS )) -enddate -in "$target" >/dev/null 2>&1
expiry=$?
if [ $expiry -eq 0 ]; then
    echo "Certificate will not expire (RC=0)"
    exit 0
else
    echo "Certificate will expire (RC=1)"
    exit 1
fi

This script returns 0 when the given certificate will not expire, otherwise it returns a non-0 value. The Perl script above will renew certificates 30 days before expiration only.

The last piece is the Apache configuration to be used on these domains:

1
2
3
4

    SSLEngine on
    SSLCertificateFile /var/www/domain1.com/certs/cert.pem
    SSLCertificateKeyFile /var/www/domain1.com/certs/privkey.pem
    SSLCertificateChainFile /var/www/domain1.com/certs/fullchain.pem

I run the central Perl script above daily and do not need to worry about certificates anymore 🙂

Categories
Linux Perl

Nonblocking sockets and Perl’s Net::Daemon

I was writing a Perl-based proxy for line-based SMTP protocol. The main reason doing this is because I receive unwanted e-mail bounces that are not filtered out by my SpamAssassin. The idea was to hook into the mail delivery chain and to collect e-mail addresses that I use. The proxy can later then filter out any bounce message that was not originated by myself.

I decided to use the Net::Daemon module which has a quite fancy interface. One just writes a single function which handles the client connection. As I didn’t want to learn every detail of SMTP protocol, I simply use non-blocking sockets. So whoever of the two parties wants to talk, it can do so and my proxy will just listen to the chat. The IO::Select documentation tells you to do this when you have multiple sockets to react on:

1
2
3
4
5
6
7
8
9
10
11
12

# Prepare selecting
$select = new IO::Select();
$select->add($socket1);
$select->add($socket2);
 
# Run until timed out / select socket
while (@CANREAD = $select->can_read(30)) {
    foreach $s (@CANREAD) {
        #... read the socket and do your stuff
    }
}
# Whenever there is a problem (like talk ended) the loop exits here

However, this code doesn’t work as expected. The can_read() function will not return an empty list when the sockets closed. It still returns any socket and the loop goes on forever. In fact, as we are in non-blocking mode, the script now eats up CPU time. 🙁

There are two solutions to it. The first is to check whether the given socket is still connected and then exit the loop:

1
2
3
4
5
6
7
8
9
10
11
12
13
14

# Prepare selecting
$select = new IO::Select();
$select->add($socket1);
$select->add($socket2);
 
# Run until timed out / select socket
while (@CANREAD = $select->can_read(30)) {
    foreach $s (@CANREAD) {
        if (!$s->connected()) {
            return;
        }
        #... It's safe now to read the socket and do your stuff
    }
}

The second and more clean method is just to remove the closed socket from the IO::Select object:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15

# Prepare selecting
$select = new IO::Select();
$select->add($socket1);
$select->add($socket2);
 
# Run until timed out / select socket
while (@CANREAD = $select->can_read(30)) {
    foreach $s (@CANREAD) {
        if (!$s->connected()) {
            $select->remove($s);
            next;
        }
        #... It's safe now to read the socket and do your stuff
    }
}

Then the selector runs empty and will exit the loop as well.

Categories
Miscellaneous Perl

Regular Expression for Email Addresses

[-A-Z0-9._%+]+@[-A-Z0-9.]+\.[A-Z]{2,4}

Categories
Apache Perl

Installing Bugzilla

This was weird. I lately tried to install Bugzilla on one of my virtual hosts but it’s testserver.pl script failed with:

Use of uninitialized value in pattern match (m//) at ./testserver.pl line 110.
Use of uninitialized value in pattern match (m//) at ./testserver.pl line 110.
TEST-FAILED Webserver is not executing CGI files.

The Apache error log told nothing more than

Premature end of script headers: testagent.cgi

All Google lookups failed to solve my problem. Although I had the impression that my CGI setup was somehow wrong, I couldn’t find the reason. Then I intensively checked the VirtualHost directive. The server uses a Plesk 8.0 installation for setting up hosts. The default configuration for virtual hosts with CGI there is to include a “SuexecUserGroup” directive. After removing it, the Bugzilla installation succeeded.

So you might wanna give it a try 😉

Update May 6, 2012: You might also want to try these commands when experiencing “Access Denied” problems in a virtual host environment:

find . -type f -exec chmod o+r {} \;
find . -type d -exec chmod o+rx {} \;

Do not forget to revert this change for localconfig file!!!

Categories
Perl

Scanning directories with Perl

I often come across a task to do specific processing for each file at a subdirectory tree. Here is a skeleton code for what you need to get it started.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57

#!/usr/bin/perl
 
my $ROOTDIR = shift;
processDir($ROOTDIR);
 
exit 0;
 
# This is the main routine. Do not change it unless you know what you do!
sub processDir {
   my $dir = shift;
   my (@FILES, $entry, $path);
 
   if (opendir(DIRIN, $dir)) {
      @FILES = readdir(DIRIN);
      closedir(DIRIN);
 
      # iterate over dir entries
      foreach $entry (@FILES) {
         next if $entry eq '..';
         next if $entry eq '.';
         $path = "$dir/$entry";
 
         if (-f $path) {
            if (fileCheck($path)) {
               processFile($path);
            }
         } elsif (-d $path) {
            if (dirCheck($path)) {
               # recurse into subdir
               processDir($path);
            }
         }
      }
   }
}
 
# Do your file processing in this function only
# $file will have the complete path
sub processFile {
   my $file = shift;
}
 
# This function decides whether a file should be processed or not
# Return 1 when you want a file to be processed
# $file will have the complete path
sub fileCheck {
   my $file = shift;
   return 1;
}
 
# This function decides whether a directory should be searched recursively.
# Return 1 when you want the algorithm to steep into the directory.
# $dir will have the complete path
sub dirCheck {
   my $dir = shift;
   return 1;
}

You only will need to override lines 39-41. In case you don’t want to handle all files and directories, just make appropriate implementations in functions checkFile() and checkDir() respectively. This code works on all platforms.

Categories
Perl

Perl Message Logging

The following code is a quick and dirty, but nevertheless usefull snippet to add logging facility to any perl script. You might want to add additional severities at lines 2-6, change the timestamp format at line 14, or enable logging into a file at lines 42-54.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66

# Defines severities of messages to log
my %TYPES = (
   ERROR => 1,
   DEBUG => 1,
   INFO  => 1
);
 
# Creates the time string for log messages
# Usage: getTimestring($unixTimeValue)
sub getTimestring {
   my $t = shift;
   $t = time if !$t;
   my @T = localtime($t);
   my $time = sprintf("%02d/%02d/%04d %02d:%02d:%02d",
              $T[3], $T[4]+1, $T[5]+1900, $T[2], $T[1], $T[0]);
   return $time;
}
 
# logs an error message
# Usage: logError($message);
sub logError {
   my $s = shift;
   logEntry($s, 'ERROR');
}
 
# logs an information message
# Usage: logInfo($message);
sub logInfo {
   my $s = shift;
   logEntry($s, 'INFO');
}
 
# logs a debug message
# Usage: logDebug($message);
sub logDebug {
   my $s = shift;
   logEntry($s, 'DEBUG');
}
 
# logs a single entry with given message severity
# Usage: logEntry($message, $severity);
sub logEntry {
   my $s = shift;
   my $type = shift;
   return if !$TYPES{$type};
 
   # build timestamp and string
   $type = rpad($type, 5);
   my $time = getTimestring();
   $s =~ s/\n/\n$time $type - /g;
 
   # print to STDOUT if required
   print "$time $type - $s\n";
}
 
# Right pads a string
# Usage: rpad($string, $maxlen[, $padchar]);
sub rpad {
   my $s = shift;
   my $len = shift;
   my $char = shift;
 
   $char = ' ' if !$char;
   $s .= $char while (length($s) &lt; $len);
   return $s;
}
Categories
Java PHP Perl

URL Parameter Transforming

Need to transform URL parameters and decode values such as “Hello%20World!”? Here is how:

Perl:

$s =~ s/%([\da-f][\da-f])/chr( hex($1) )/egi;

Java:

s = java.net.URLEncoder.encode(s, "UTF-8");

PHP:

$s = urldecode($s);