Tag Archives: messaging

Get your DMARC going

Get your company implementing DMARC now…

During the past 5-6 years email industry efforts have been pushing the DMARC standard along. It provides the best widely supported and seemingly efficient way to – as a domain-owner – protect the domain from misuse and abuse in terms of spam and phishing attacks.

postkasse_japanAs sending email has often been a wild-west, and knowing who is a valid sender of email may prove a challenge for many companies – and as most IT developers does seem to care too much about the finer details of email (and production just as bad email headers as HTML markup ­čÖé ), implementing DMARC protection on your domain may actually be a challenge.

The DMARC standard provide you 3 powerful tools:

  • Using DMARC you have the power (through) DNS to declare which mail-servers are valid senders of email from your domain.
  • The DKIM signing of mails allows your to prove to recipients it was sent from a valid server.
  • Finally┬áDMARC ┬áprovides a way for the email receiver to report back to the sender about messages that pass and/or fail DMARC evaluation.

In summary, you have the option to protect the credibility of your domain (by not exposing it to spam and phishing), and you should care now, as Google through Gmail seems to be starting to push harder to signal which email is “safe” (or legitimate at least).

This latter effort will not only remove fake emails pretending to be from your domain, but it will likely also promote your legitimate emails and make them more likely to reach their audience.

Here are a few articles on how to get on with DMARC implementation:

 

 

Search in a LDAP directory

This example connects to a LDAP server and makes a search for a name. The name was choosen by random (among those who returned an answer from the queried LDAP). The LDAP used in this example includes a binary certificate. To prevent this from trashing you terminal, it is not printed to the screen (binary field filtered in the attribute loop).

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
#!/usr/bin/perl -w
use strict;
 
use Net::LDAP;
my $ldap = Net::LDAP->new('directory.certifikat.dk') or die "$@";
$ldap->bind ;    # an anonymous bind
 
my $mesg = $ldap->search (  # perform a search
                       base   => "c=DK",
                       filter => "(&(cn=Henrik Jensen))"
 
                      );
 
$mesg->code && die $mesg->error;
 
print STDERR "Found " . $mesg->count . "n";
foreach my $entry ($mesg->all_entries) {
  my  @values = $entry->attributes();
  foreach my $key (@values) {
    print "$key => \"" . $entry->get_value($key) ."\"n" unless ($key =~ /binary/);
  }
}
 
exit();

Mark all messages as read in an imap folder

The follow script marks all files in a folder as read. You need to pass hostname, username and password as commandline parameters to the script and the script is hardwired to mark all files in a folder call “INBOX.spam” (Cyrus IMAP folder naming convention).

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
#!/usr/bin/perl -w
use strict;
 
use Mail::IMAPClient::BodyStructure;
use Mail::IMAPClient;
 
my ($serv, $usr, $pwd) = (@ARGV); # server, username and password as comandline parameters...
 
my $imap = Mail::IMAPClient->new(Server=>$serv,User=>$usr,Password=>$pwd);
my @folders = $imap->folders;
 
foreach my $f (@folders) {
  print 	"$f is a folder with ", $imap->message_count($f), " messages.n";
}
 
exit();

Which IMAP-folders exist?

The following script will make a list of which folders exist in an IMAP account. The script requires you pass hostname, accountname and password on the commandline, but it should be quite easy to change as you like.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
#!/usr/bin/perl -w
use strict;
 
use Mail::IMAPClient::BodyStructure;
use Mail::IMAPClient;
 
my ($serv, $usr, $pwd) = (@ARGV); # server, username and password as comandline parameters...
 
my $imap = Mail::IMAPClient->new(Server=>$serv,User=>$usr,Password=>$pwd);
my @folders = $imap->folders;
 
foreach my $f (@folders) {
  print 	"$f is a folder with ", $imap->message_count($f), " messages.n";
}
 
exit();

POP3: List messages in mailbox

Lists sender and subject on all mails in mailbox. MIME::WordDecoder is used to parse heads as most mails often has ISO-8859-1 encoded parts. It should be save to test it on any mailbox as it dosn’t change or remove anything from the mailbox.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
#!/usr/local/bin/perl -w
use strict;
use Mail::POP3Client;
use MIME::WordDecoder;
 
my ($serv, $usr, $pwd) = (@ARGV); # server, username and password as comandline parameters...
 
my $wd = default MIME::WordDecoder;
 
my $pop = new Mail::POP3Client( USER => $usr, PASSWORD => $pwd, HOST => $serv );
print "Found " . $pop->Count() . " messages.n";
for (my $i = 1; $i <= $pop->Count(); $i++) {
  foreach ( $pop->Head( $i ) ) {
    if (/^(From|Subject):s+/i) {
  print $wd->decode($_);
    }
  }
  print "n";
}
 
exit();

Fetching recent headlines from a news server

The followig piece connects to a news-server and fetches subjects from the last week in a specific newsgroup (the Danish perl-newsgroup) and prints these.

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
#!/usr/bin/perl -w
use strict;
use Net::NNTP;
use MIME::Base64 qw(decode_base64);
use MIME::QuotedPrint qw(decode_qp);
 
my  $server= "sunsite.auc.dk";
print STDERR "connecting to $server... ";
my $nntp= Net::NNTP->new($server);
unless($nntp) {
  print STDERR "failedn";
  exit 1;
}
print STDERR "okn";
 
print STDERR "getting messages... ";
my $newstuff= $nntp->newnews(time - 7*24*2600, "dk.edb.programmering.perl");
unless($newstuff) {
  print STDERR "failedn";
  exit 1;
}
print STDERR "okn";
 
my @messages;
foreach my $msgid (@$newstuff) {
  my $head= $nntp->head($msgid);
  next unless $head;
 
  my %msg;
  push @messages, %msg;
  foreach(@$head) {
    next unless /^(Newsgroups|Subject|From):s+(.+)$/i;
    $msg{lc $1}= $2;
  }
}
 
my $last= "";
foreach(sort { $a->{newsgroups} cmp $b->{newsgroups} } @messages) {
  if($_->{newsgroups} ne $last) {
    print "n" if $last;
    $last= $_->{newsgroups};
    print "$last:n";
  }
  print "t" . decode_header($_->{subject}) .
    " - " . decode_header($_->{from}) ."n";
}
 
sub decode_header {
  my($text)= @_;
 
  $text=~ s/=?(iso-?8859-.?|us-ascii|utf-8)?(q|b)?([^?]*)?=(s*(?==?))?/&decode_header_block(lc $1,$2,$3);/gei;
  return $text;
}
 
sub decode_header_block {
  my ($input,$enc,$text) = @_;
  if ($enc =~ /q/i) {
    $text=~ s/_/ /g;
    $text= decode_qp($text);
  } else {
    $text= decode_base64($text);
  }
  return $text; # oh well  [:-)]
}
 
exit();

Fetching available newsgroups from a news server

This script fetches a list of available newsgroups (and descriptions) from a news server. The group list is returned as a hashref where the keys are the groupname and the value is a description of the group.

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
#!/usr/bin/perl -w
use strict;
use Net::NNTP;
use MIME::Base64 qw(decode_base64);
use MIME::QuotedPrint qw(decode_qp);
 
my  $server= "sunsite.auc.dk";
print STDERR "connecting to $server... ";
my $nntp= Net::NNTP->new($server);
unless($nntp) {
  print STDERR "failedn";
  exit 1;
}
print STDERR "okn";
 
print STDERR "getting messages... ";
my $newstuff= $nntp->newnews(time - 7*24*2600, "dk.edb.programmering.perl");
unless($newstuff) {
  print STDERR "failedn";
  exit 1;
}
print STDERR "okn";
 
my @messages;
foreach my $msgid (@$newstuff) {
  my $head= $nntp->head($msgid);
  next unless $head;
 
  my %msg;
  push @messages, %msg;
  foreach(@$head) {
    next unless /^(Newsgroups|Subject|From):s+(.+)$/i;
    $msg{lc $1}= $2;
  }
}
 
my $last= "";
foreach(sort { $a->{newsgroups} cmp $b->{newsgroups} } @messages) {
  if($_->{newsgroups} ne $last) {
    print "n" if $last;
    $last= $_->{newsgroups};
    print "$last:n";
  }
  print "t" . decode_header($_->{subject}) .
    " - " . decode_header($_->{from}) ."n";
}
 
sub decode_header {
  my($text)= @_;
 
  $text=~ s/=?(iso-?8859-.?|us-ascii|utf-8)?(q|b)?([^?]*)?=(s*(?==?))?/&decode_header_block(lc $1,$2,$3);/gei;
  return $text;
}
 
sub decode_header_block {
  my ($input,$enc,$text) = @_;
  if ($enc =~ /q/i) {
    $text=~ s/_/ /g;
    $text= decode_qp($text);
  } else {
    $text= decode_base64($text);
  }
  return $text; # oh well  [:-)]
}
 
exit();