File Coverage

blib/lib/Net/ACME2/Challenge/http_01/Handler.pm
Criterion Covered Total %
statement 51 54 94.4
branch 7 12 58.3
condition 2 3 66.6
subroutine 8 8 100.0
pod 0 1 0.0
total 68 78 87.1


line stmt bran cond sub pod time code
1             package Net::ACME2::Challenge::http_01::Handler;
2              
3             =encoding utf-8
4              
5             =head1 NAME
6              
7             Net::ACME2::Challenge::http_01::Handler - http-01 challenge handler
8              
9             =head1 DESCRIPTION
10              
11             This module handles the creation and removal of a domain control
12             validation (DCV) file for http-01 challenges. Creation happens on
13             instantiation; removal happens when the object is destroyed.
14              
15             See L for a usage example.
16              
17             =cut
18              
19 1     1   516 use strict;
  1         2  
  1         31  
20 1     1   5 use warnings;
  1         2  
  1         23  
21 1     1   5 use autodie;
  1         3  
  1         9  
22              
23 1     1   5751 use Errno ();
  1         3  
  1         825  
24              
25             our $ASSUME_UNIX_PATHS;
26              
27             my @required = qw( key_authorization challenge document_root );
28              
29             sub new {
30 2     2 0 12 my ( $class, %opts ) = @_;
31              
32             #sanity
33 2         6 my @missing = grep { !defined $opts{$_} } @required;
  6         18  
34 2 50       8 die "Missing: [@missing]" if @missing;
35              
36 2 50       36 -d $opts{'document_root'} or die "Document root “$opts{'document_root'}” doesn’t exist!";
37              
38 2         7 my ($file_path, $dir);
39              
40 2 50       7 if ($ASSUME_UNIX_PATHS) {
41 0         0 $file_path = $opts{'document_root'} . $opts{'challenge'}->path();
42 0         0 $dir = substr( $file_path, rindex( $file_path, '/' ) );
43             }
44             else {
45 2         23 require File::Spec;
46              
47 2         11 my @relpath = split m, $opts{'challenge'}->path();
48              
49             $file_path = File::Spec->catdir(
50 2         17 $opts{'document_root'},
51             @relpath,
52             );
53              
54             $dir = File::Spec->catdir(
55 2         18 $opts{'document_root'},
56             @relpath[ 0 .. ($#relpath - 1) ],
57             );
58             }
59              
60 2         8 _mkdir_if_not_exists($dir);
61              
62 2         14 local ( $!, $^E );
63              
64 2         11 open my $wfh, '>', $file_path;
65 2         2982 chmod 0644, $file_path;
66 2         373 syswrite $wfh, $opts{'key_authorization'};
67 2         1619 close $wfh;
68              
69 2         970 my $self = {
70             _euid => $>,
71             _path => $file_path,
72             #_docroot_relative_path => $docroot_relative_path,
73             #_content => $opts{'key_authorization'},
74             };
75              
76 2         28 return bless $self, $class;
77             }
78              
79             #sub expected_content {
80             # my ($self) = @_;
81             #
82             # return $self->{'_content'};
83             #}
84             #
85             #sub verification_path {
86             # my ($self) = @_;
87             #
88             # return "/$self->{'_docroot_relative_path'}";
89             #}
90              
91             sub DESTROY {
92 2     2   1482 my ($self) = @_;
93              
94 2 50       24 if ( $> != $self->{'_euid'} ) {
95 0         0 die "XXX attempt to delete “$self->{'_path'}” with EUID $>; created with EUID $self->{'_euid'}!";
96             }
97              
98 2         11 _unlink_if_exists( $self->{'_path'} );
99              
100 2         17 return;
101             }
102              
103             sub _mkdir_if_not_exists {
104 2     2   6 my ($dir) = @_;
105              
106 2 100       41 if (!-d $dir) {
107 1         7 require File::Path;
108              
109             #cf. eval_bug.readme
110 1         3 my $eval_err = $@;
111              
112 1         19 local ( $!, $^E );
113              
114 1         317 File::Path::make_path($dir);
115              
116 1         8 $@ = $eval_err;
117             }
118              
119 2         8 return;
120             }
121              
122             sub _unlink_if_exists {
123 2     2   5 my ($path) = @_;
124              
125             #cf. eval_bug.readme
126 2         5 my $eval_err = $@;
127              
128 2         13 local ( $!, $^E );
129              
130 2         3 eval { unlink $path };
  2         9  
131              
132 2 50 66     5404 die if $@ && $@->errno() != Errno::ENOENT();
133              
134 2         129 $@ = $eval_err;
135              
136 2         15 return;
137             }
138              
139             1;