| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package AWS::S3::Roles::Bucket; |
|
2
|
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
1033
|
use Moose::Role; |
|
|
1
|
|
|
|
|
3099
|
|
|
|
1
|
|
|
|
|
3
|
|
|
4
|
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
sub bucket_uri { |
|
6
|
1
|
|
|
1
|
0
|
2
|
my ( $s,$path ) = @_; |
|
7
|
|
|
|
|
|
|
|
|
8
|
1
|
|
33
|
|
|
3
|
$path //= $s->bucket; |
|
9
|
1
|
0
|
|
|
|
21
|
my $protocol = $s->s3->secure ? 'https' : 'http'; |
|
10
|
0
|
|
|
|
|
|
my $endpoint = $s->s3->endpoint; |
|
11
|
0
|
|
|
|
|
|
my $uri = "$protocol://$endpoint/$path"; |
|
12
|
0
|
0
|
0
|
|
|
|
if ( $path =~ m{^([^/?]+)(.*)} && $s->is_dns_bucket( $1 ) ) { |
|
13
|
0
|
|
|
|
|
|
$uri = "$protocol://$1.$endpoint$2"; |
|
14
|
|
|
|
|
|
|
} # end if() |
|
15
|
|
|
|
|
|
|
|
|
16
|
0
|
|
|
|
|
|
return $uri; |
|
17
|
|
|
|
|
|
|
} |
|
18
|
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
sub is_dns_bucket { |
|
20
|
0
|
|
|
0
|
0
|
|
my ( $s,$bucket ) = @_; |
|
21
|
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
# https://docs.aws.amazon.com/AmazonS3/latest/dev/BucketRestrictions.html |
|
23
|
0
|
0
|
0
|
|
|
|
return 0 if ( length( $bucket ) < 3 or length( $bucket ) > 63 ); |
|
24
|
0
|
0
|
|
|
|
|
return 0 if $bucket =~ /^(?:\d{1,3}\.){3}\d{1,3}$/; |
|
25
|
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
# DNS bucket names can contain lowercase letters, numbers, and hyphens |
|
27
|
|
|
|
|
|
|
# so anything outside this range we say isn't a valid DNS bucket |
|
28
|
0
|
0
|
|
|
|
|
return $bucket =~ /[^a-z0-9-\.]/ ? 0 : 1; |
|
29
|
|
|
|
|
|
|
} |
|
30
|
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
1; |