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   481 use strict;
  1         3  
  1         29  
20 1     1   6 use warnings;
  1         2  
  1         28  
21 1     1   6 use autodie;
  1         2  
  1         15  
22              
23 1     1   7040 use Errno ();
  1         3  
  1         881  
24              
25             our $ASSUME_UNIX_PATHS;
26              
27             my @required = qw( key_authorization challenge document_root );
28              
29             sub new {
30 2     2 0 11 my ( $class, %opts ) = @_;
31              
32             #sanity
33 2         7 my @missing = grep { !defined $opts{$_} } @required;
  6         15  
34 2 50       6 die "Missing: [@missing]" if @missing;
35              
36 2 50       32 -d $opts{'document_root'} or die "Document root “$opts{'document_root'}” doesn’t exist!";
37              
38 2         6 my ($file_path, $dir);
39              
40 2 50       10 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         15 require File::Spec;
46              
47 2         11 my @relpath = split m, $opts{'challenge'}->path();
48              
49             $file_path = File::Spec->catdir(
50 2         13 $opts{'document_root'},
51             @relpath,
52             );
53              
54             $dir = File::Spec->catdir(
55 2         15 $opts{'document_root'},
56             @relpath[ 0 .. ($#relpath - 1) ],
57             );
58             }
59              
60 2         8 _mkdir_if_not_exists($dir);
61              
62 2         11 local ( $!, $^E );
63              
64 2         11 open my $wfh, '>', $file_path;
65 2         2365 chmod 0644, $file_path;
66 2         306 syswrite $wfh, $opts{'key_authorization'};
67 2         1161 close $wfh;
68              
69 2         768 my $self = {
70             _euid => $>,
71             _path => $file_path,
72             #_docroot_relative_path => $docroot_relative_path,
73             #_content => $opts{'key_authorization'},
74             };
75              
76 2         29 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   1136 my ($self) = @_;
93              
94 2 50       21 if ( $> != $self->{'_euid'} ) {
95 0         0 die "XXX attempt to delete “$self->{'_path'}” with EUID $>; created with EUID $self->{'_euid'}!";
96             }
97              
98 2         8 _unlink_if_exists( $self->{'_path'} );
99              
100 2         24 return;
101             }
102              
103             sub _mkdir_if_not_exists {
104 2     2   5 my ($dir) = @_;
105              
106 2 100       34 if (!-d $dir) {
107 1         7 require File::Path;
108              
109             #cf. eval_bug.readme
110 1         2 my $eval_err = $@;
111              
112 1         17 local ( $!, $^E );
113              
114 1         232 File::Path::make_path($dir);
115              
116 1         5 $@ = $eval_err;
117             }
118              
119 2         6 return;
120             }
121              
122             sub _unlink_if_exists {
123 2     2   4 my ($path) = @_;
124              
125             #cf. eval_bug.readme
126 2         5 my $eval_err = $@;
127              
128 2         9 local ( $!, $^E );
129              
130 2         2 eval { unlink $path };
  2         7  
131              
132 2 50 66     4361 die if $@ && $@->errno() != Errno::ENOENT();
133              
134 2         115 $@ = $eval_err;
135              
136 2         17 return;
137             }
138              
139             1;