File Coverage

blib/lib/Mail/JMAPTalk.pm
Criterion Covered Total %
statement 16 18 88.8
branch n/a
condition n/a
subroutine 6 6 100.0
pod n/a
total 22 24 91.6


line stmt bran cond sub pod time code
1             #!/usr/bin/perl -cw
2              
3 1     1   31062 use strict;
  1         3  
  1         56  
4 1     1   7 use warnings;
  1         2  
  1         67  
5              
6             package Mail::JMAPTalk;
7              
8 1     1   1468 use HTTP::Tiny;
  1         79102  
  1         88  
9 1     1   1463 use JSON::XS qw(decode_json encode_json);
  1         11824  
  1         110  
10 1     1   804 use Convert::Base64;
  1         1320  
  1         54  
11 1     1   225 use File::LibMagic;
  0            
  0            
12             use Carp qw(confess);
13             use Data::Dumper;
14              
15             our $VERSION = '0.06';
16              
17             our $CLIENT = "Net-JMAPTalk";
18             our $AGENT = "$CLIENT/$VERSION";
19              
20             sub new {
21             my ($Proto, %Args) = @_;
22             my $Class = ref($Proto) || $Proto;
23              
24             my $Self = bless { %Args }, $Class;
25              
26             return $Self;
27             }
28              
29             sub ua {
30             my $Self = shift;
31             unless ($Self->{ua}) {
32             $Self->{ua} = HTTP::Tiny->new(agent => $AGENT);
33             }
34             return $Self->{ua};
35             }
36              
37             sub auth_header {
38             my $Self = shift;
39             return 'Basic ' . encode_base64("$Self->{user}:$Self->{password}", '');
40             }
41              
42             sub uploaduri {
43             my $Self = shift;
44             my $scheme = $Self->{scheme} // 'http';
45             my $host = $Self->{host} // 'localhost';
46             my $port = $Self->{port} // ($scheme eq 'http' ? 80 : 443);
47             my $url = $Self->{uploadurl} // '/jmap/upload';
48              
49             return $url if $url =~ m/^http/;
50              
51             return "$scheme://$host:$port$url";
52             }
53              
54             sub downloaduri {
55             my $Self = shift;
56             my ($accountId, $blobId, $name) = @_;
57             die "need account and blob" unless ($accountId and $blobId);
58             $name ||= "download";
59             my $scheme = $Self->{scheme} // 'http';
60             my $host = $Self->{host} // 'localhost';
61             my $port = $Self->{port} // ($scheme eq 'http' ? 80 : 443);
62             my $url = $Self->{downloadurl} // '/jmap/download/{accountId}/{blobId}/{name}';
63              
64             my %map = (
65             accountId => $accountId,
66             blobId => $blobId,
67             name => $name,
68             );
69              
70             $url =~ s/\{([a-zA-Z0-9_]+)\}/$map{$1}||''/ges;
71              
72             return $url if $url =~ m/^http/;
73              
74             return "$scheme://$host:$port$url";
75             }
76              
77             sub uri {
78             my $Self = shift;
79             my $scheme = $Self->{scheme} // 'http';
80             my $host = $Self->{host} // 'localhost';
81             my $port = $Self->{port} // ($scheme eq 'http' ? 80 : 443);
82             my $url = $Self->{url} // '/jmap';
83              
84             return $url if $url =~ m/^http/;
85              
86             return "$scheme://$host:$port$url";
87             }
88              
89             sub Login {
90             my ($Self, $Username, $Password) = @_;
91              
92             my $data = $Self->AuthRequest({
93             username => $Username,
94             clientName => $CLIENT,
95             clientVersion => $VERSION,
96             deviceName => $Self->{deviceName} || 'api',
97             });
98              
99             while ($data->{continuationToken}) {
100             die "Unknown method" unless grep { $_ eq 'password' } @{$data->{methods}};
101             $data = $Self->Request({
102             token => $data->{continuationToken},
103             method => 'password',
104             password => $Password,
105             });
106             }
107              
108             die "Failed to get a token" unless $data->{accessToken};
109              
110             $Self->{token} = $data->{accessToken};
111             $Self->{url} = $data->{uri};
112             $Self->{upload} = $data->{upload};
113             $Self->{eventSource} = $data->{eventSource};
114              
115             return 1;
116             }
117              
118             sub Request {
119             my ($Self, $Requests, %Headers) = @_;
120              
121             $Headers{'Content-Type'} //= "application/json";
122              
123             if ($Self->{user}) {
124             $Headers{'Authorization'} = $Self->auth_header();
125             }
126             if ($Self->{token}) {
127             $Headers{'Authorization'} = "JMAP $Self->{token}";
128             }
129              
130             my $uri = $Self->uri();
131              
132             my $Response = $Self->ua->post($uri, {
133             headers => \%Headers,
134             content => encode_json($Requests),
135             });
136              
137             my $jdata;
138             $jdata = eval { decode_json($Response->{content}) } if $Response->{success};
139              
140             if ($ENV{DEBUGJMAP}) {
141             warn "JMAP " . Dumper($Requests, $Response);
142             }
143              
144             # check your own success on the Response object
145             if (wantarray) {
146             return ($Response, $jdata);
147             }
148              
149             confess "JMAP request for $Self->{user} failed ($uri): $Response->{status} $Response->{reason}: $Response->{content}"
150             unless $Response->{success};
151              
152             confess "INVALID JSON $Response->{content}" unless $jdata;
153              
154             return $jdata;
155             }
156              
157             sub _get_type {
158             my $data = shift;
159             # XXX - escape file names?
160             my $magic = File::LibMagic->new();
161             my $info = $magic->info_from_string($data);
162             return $info->{mime_type};
163             }
164              
165             sub Upload {
166             my ($Self, $data, $type) = @_;
167              
168             my %Headers;
169             $Headers{'Content-Type'} = $type || _get_type($data);
170              
171             if ($Self->{user}) {
172             $Headers{'Authorization'} = $Self->auth_header();
173             }
174             if ($Self->{token}) {
175             $Headers{'Authorization'} = "JMAP $Self->{token}";
176             }
177              
178             my $uri = $Self->uploaduri();
179              
180             my $Response = $Self->ua->post($uri, {
181             headers => \%Headers,
182             content => $data,
183             });
184              
185             if ($ENV{DEBUGJMAP}) {
186             warn "JMAP UPLOAD " . Dumper($Response);
187             }
188              
189             my $jdata;
190             $jdata = eval { decode_json($Response->{content}) } if $Response->{success};
191              
192             # check your own success on the Response object
193             if (wantarray) {
194             return ($Response, $jdata);
195             }
196              
197             confess "JMAP request for $Self->{user} failed ($uri): $Response->{status} $Response->{reason}: $Response->{content}"
198             unless $Response->{success};
199              
200             confess "INVALID JSON $Response->{content}" unless $jdata;
201              
202             return $jdata;
203             }
204              
205             sub Download {
206             my $Self = shift;
207             my $cb;
208             if (ref($_[0]) eq 'CODE') {
209             $cb = shift;
210             }
211             my $uri = $Self->downloaduri(@_);
212              
213             my %Headers;
214             if ($Self->{user}) {
215             $Headers{'Authorization'} = $Self->auth_header();
216             }
217             if ($Self->{token}) {
218             $Headers{'Authorization'} = "JMAP $Self->{token}";
219             }
220              
221             my %getopts = (headers => \%Headers);
222             $getopts{data_callback} = $cb if $cb;
223             my $Response = $Self->ua->get($uri, \%getopts);
224              
225             if ($ENV{DEBUGJMAP}) {
226             warn "JMAP DOWNLOAD @_ " . Dumper($Response);
227             }
228              
229             die "Failed to download $uri" unless $Response->{success};
230             return $Response;
231             }
232              
233             1;
234             __END__