File Coverage

blib/lib/Mail/Run/Crypt.pm
Criterion Covered Total %
statement 39 61 63.9
branch 15 28 53.5
condition 0 3 0.0
subroutine 11 13 84.6
pod 3 3 100.0
total 68 108 62.9


line stmt bran cond sub pod time code
1             package Mail::Run::Crypt;
2              
3             # Force me to write this properly
4 6     6   428401 use strict;
  6         62  
  6         186  
5 6     6   33 use warnings;
  6         12  
  6         158  
6 6     6   34 use utf8;
  6         12  
  6         40  
7              
8             # Require this version of Perl
9 6     6   282 use 5.008_001;
  6         31  
10              
11             # Import required modules
12 6     6   33 use Carp;
  6         13  
  6         472  
13 6     6   2122 use English '-no_match_vars';
  6         15025  
  6         37  
14 6     6   5464 use IPC::Run3;
  6         179188  
  6         345  
15 6     6   3163 use Mail::GnuPG;
  6         2414066  
  6         254  
16 6     6   52 use MIME::Entity;
  6         14  
  6         3083  
17              
18             # Specify package verson
19             our $VERSION = '0.11';
20              
21             # Default exit value
22             our $DEFAULT_EXIT = 127; ## no critic (ProhibitMagicNumbers)
23              
24             # Oldschool constructor
25             sub new {
26 7     7 1 1452 my ( $class, %opts ) = @_;
27              
28             # Blindly slurp in all the options given
29 7         29 my $self = {%opts};
30              
31             # We must have a recipient
32             defined $self->{mailto}
33 7 100       199 or croak 'MAILTO required';
34              
35             # Default the instance name to the package name if it wasn't given;
36             # runcrypt(1) will pass it in
37 6 100       27 defined $self->{name} or $self->{name} = $class;
38              
39             # We default to encrypting but not signing
40 6 100       25 defined $self->{encrypt} or $self->{encrypt} = 1;
41 6 100       34 defined $self->{sign} or $self->{sign} = 0;
42              
43             # If signing, we need a key ID and a passphrase
44 6 100       20 if ( $self->{sign} ) {
45             defined $self->{keyid}
46 3 100       224 or croak 'Key ID required for signing';
47             defined $self->{passphrase}
48 2 100       125 or croak 'Passphrase required for signing';
49             }
50              
51             # Return objectified self
52 4         32 return bless $self, $class;
53             }
54              
55             # Run a given command
56             sub run {
57 0     0 1 0 my ( $self, @command ) = @_;
58              
59             # Run the command and wait for it to finish; keep its exit value for later
60 0         0 my ( @out, @err );
61 0 0       0 eval { run3 \@command, undef, \@out, \@err }
  0         0  
62             or warn "Command failed: $EVAL_ERROR\n";
63 0         0 $self->{exit} = $CHILD_ERROR >> 8;
64              
65             # If there was output, mail it
66 0 0       0 if (@out) {
67 0         0 my $command = join q{ }, @command;
68 0         0 my $subject = "$self->{name} output: $command";
69 0         0 $self->_mail( $subject, \@out );
70             }
71              
72             # If there were errors, mail them
73 0 0       0 if (@err) {
74 0         0 my $command = join q{ }, @command;
75 0         0 my $subject = "$self->{name} errors: $command";
76 0         0 $self->_mail( $subject, \@err );
77             }
78              
79             # Return status reflecting the command exit value
80 0         0 return $self->{exit} == 0;
81             }
82              
83             # Return the value of the most recently run command, or 1 otherwise
84             sub bail {
85 2     2 1 2300 my $self = shift;
86             my $exit =
87             defined $self->{exit}
88             ? $self->{exit}
89 2 50       15 : $DEFAULT_EXIT;
90 2         10 return $exit;
91             }
92              
93             # Send the message to the address in $ENV{MAILTO}
94             sub _mail {
95 0     0     my ( $self, $subject, $content ) = @_;
96              
97             # Build MIME object with plaintext message
98             my $mime = MIME::Entity->build(
99             To => $self->{mailto},
100 0           Subject => $subject,
101             Data => $content,
102             );
103              
104             # Encrypt the MIME object
105             my $mgpg = Mail::GnuPG->new(
106             key => $self->{keyid},
107             passphrase => $self->{passphrase},
108 0           );
109              
110             # Sign and/or encrypt as appropriate
111 0 0 0       if ( $self->{sign} and $self->{encrypt} ) {
    0          
    0          
112 0           $mgpg->mime_signencrypt( $mime, $self->{mailto} );
113             }
114             elsif ( $self->{sign} ) {
115 0           $mgpg->mime_sign( $mime, $self->{mailto} );
116             }
117             elsif ( $self->{encrypt} ) {
118 0           $mgpg->mime_encrypt( $mime, $self->{mailto} );
119             }
120              
121             # Send it
122 0           return $mime->send();
123             }
124              
125             1;
126              
127             __END__