File Coverage

blib/lib/Net/ACME2/Challenge/http_01/Handler.pm
Criterion Covered Total %
statement 52 55 94.5
branch 9 14 64.2
condition n/a
subroutine 8 8 100.0
pod 0 1 0.0
total 69 78 88.4


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