File Coverage

blib/lib/App/MatrixTool.pm
Criterion Covered Total %
statement 51 205 24.8
branch 0 46 0.0
condition 0 23 0.0
subroutine 17 46 36.9
pod 0 21 0.0
total 68 341 19.9


line stmt bran cond sub pod time code
1             # You may distribute under the terms of either the GNU General Public License
2             # or the Artistic License (the same terms as Perl itself)
3             #
4             # (C) Paul Evans, 2015 -- leonerd@leonerd.org.uk
5              
6             package App::MatrixTool;
7              
8 1     1   463 use strict;
  1         2  
  1         24  
9 1     1   3 use warnings;
  1         1  
  1         37  
10              
11             our $VERSION = '0.07';
12              
13 1     1   593 use Getopt::Long qw( GetOptionsFromArray );
  1         7360  
  1         3  
14 1     1   826 use Future;
  1         7913  
  1         38  
15 1     1   7 use List::Util 1.29 qw( pairmap );
  1         25  
  1         111  
16 1     1   611 use MIME::Base64 qw( encode_base64 );
  1         559  
  1         48  
17 1     1   477 use Module::Pluggable::Object;
  1         7577  
  1         29  
18 1     1   5 use Module::Runtime qw( use_package_optimistically );
  1         1  
  1         4  
19 1     1   31 use Scalar::Util qw( blessed );
  1         1  
  1         43  
20 1     1   566 use Socket qw( getnameinfo AF_INET AF_INET6 AF_UNSPEC NI_NUMERICHOST NI_NUMERICSERV );
  1         3461  
  1         150  
21 1     1   401 use Struct::Dumb qw( readonly_struct );
  1         1129  
  1         4  
22              
23 1     1   491 use Protocol::Matrix::HTTP::Federation;
  1         17246  
  1         1202  
24              
25             my $opt_parser = Getopt::Long::Parser->new(
26             config => [qw( require_order )],
27             );
28              
29             =head1 NAME
30              
31             C - commands to interact with a Matrix home-server
32              
33             =head1 SYNOPSIS
34              
35             Usually this would be used via the F command
36              
37             $ matrixtool server-key matrix.org
38              
39             =head1 DESCRIPTION
40              
41             Provides the base class and basic level support for commands that interact
42             with a Matrix home-server. See individual command modules, found under the
43             C namespace, for details on specific commands.
44              
45             =cut
46              
47             readonly_struct ArgSpec => [qw( name print_name optional eatall )];
48             sub ARGSPECS
49             {
50             map {
51 0     0 0   my $name = $_;
  0            
52 0           my $optional = $name =~ s/\?$//;
53 0           my $eatall = $name =~ m/\.\.\.$/;
54              
55 0           ( my $print_name = uc $name ) =~ s/_/-/g;
56              
57 0   0       ArgSpec( $name, $print_name, $optional||$eatall, $eatall )
58             } shift->ARGUMENTS;
59             }
60              
61             readonly_struct OptSpec => [qw( name print_name shortname getopt description )];
62             sub OPTSPECS
63             {
64             pairmap {
65 0     0     my ( $name, $desc ) = ( $a, $b ); # allocate new SVtPVs to placate odd COW-related bug in 5.18
66              
67 0           my $getopt = $name;
68              
69 0           $name =~ s/=.*//;
70              
71 0           my $shortname;
72 0 0         $name =~ s/^(.)\|// and $shortname = $1;
73              
74 0           my $printname = $name;
75 0           $name =~ s/-/_/g;
76              
77 0           OptSpec( $name, $printname, $shortname, $getopt, $desc )
78 0     0 0   } shift->OPTIONS;
79             }
80              
81             sub new
82             {
83 0     0 0   my $class = shift;
84 0           return bless { @_ }, $class;
85             }
86              
87             sub sock_family
88             {
89 0     0 0   my $self = shift;
90 0 0         return AF_INET if $self->{inet4};
91 0 0         return AF_INET6 if $self->{inet6};
92 0           return AF_UNSPEC;
93             }
94              
95             sub _pkg_for_command
96             {
97 0     0     my $self = shift;
98 0           my ( $cmd ) = @_;
99              
100 0   0       my $class = ref $self || $self;
101              
102 0 0         my $base = $class eq __PACKAGE__ ? "App::MatrixTool::Command" : $class;
103              
104             # Allow hyphens in command names
105 0           $cmd =~ s/-/_/g;
106              
107 0           my $pkg = "${base}::${cmd}";
108 0           use_package_optimistically( $pkg );
109             }
110              
111             sub run
112             {
113 0     0 0   my $self = shift;
114 0           my @args = @_;
115              
116 0           my %global_opts;
117             $opt_parser->getoptionsfromarray( \@args,
118             'inet4|4' => \$global_opts{inet4},
119             'inet6|6' => \$global_opts{inet6},
120             'print-request' => \$global_opts{print_request},
121             'print-response' => \$global_opts{print_response},
122 0 0         ) or return 1;
123              
124 0 0         my $cmd = @args ? shift @args : "help";
125              
126 0           my $pkg = $self->_pkg_for_command( $cmd );
127 0 0         $pkg->can( "new" ) or
128             return $self->error( "No such command '$cmd'" );
129              
130 0           my $runner = $pkg->new( %global_opts );
131              
132 0           $self->run_command_in_runner( $runner, @args );
133             }
134              
135             sub run_command_in_runner
136             {
137 0     0 0   my $self = shift;
138 0           my ( $runner, @args ) = @_;
139              
140 0           my @argvalues;
141              
142 0 0         if( $runner->can( "OPTIONS" ) ) {
143 0           my %optvalues;
144              
145             $opt_parser->getoptionsfromarray( \@args,
146 0 0         map { $_->getopt => \$optvalues{ $_->name } } $runner->OPTSPECS
  0            
147             ) or exit 1;
148              
149 0           push @argvalues, \%optvalues;
150             }
151              
152 0           my @argspecs = $runner->ARGSPECS;
153 0           while( @argspecs ) {
154 0           my $spec = shift @argspecs;
155              
156 0 0         if( !@args ) {
157 0 0         last if $spec->optional;
158              
159 0           return $self->error( "Required argument '${\ $spec->print_name }' missing" );
  0            
160             }
161              
162 0 0         if( $spec->eatall ) {
163 0           push @argvalues, @args;
164 0           @args = ();
165             }
166             else {
167 0           push @argvalues, shift @args;
168             }
169             }
170 0 0         @args and return $self->error( "Found extra arguments" );
171              
172 0           my $ret = $runner->run( @argvalues );
173 0 0 0       $ret = $ret->get if blessed $ret and $ret->isa( "Future" );
174 0   0       $ret //= 0;
175              
176 0           return $ret;
177             }
178              
179             sub output
180             {
181 0     0 0   my $self = shift;
182 0           print @_, "\n";
183              
184 0           return 0;
185             }
186              
187             # Some nicer-formatted outputs for terminals
188             sub output_ok
189             {
190 0     0 0   my $self = shift;
191 0           $self->output( "\e[32m", "[OK]", "\e[m", " ", @_ );
192             }
193              
194             sub output_info
195             {
196 0     0 0   my $self = shift;
197 0           $self->output( "\e[36m", "[INFO]", "\e[m", " ", @_ );
198             }
199              
200             sub output_warn
201             {
202 0     0 0   my $self = shift;
203 0           $self->output( "\e[33m", "[WARN]", "\e[m", " ", @_ );
204             }
205              
206             sub output_fail
207             {
208 0     0 0   my $self = shift;
209 0           $self->output( "\e[31m", "[FAIL]", "\e[m", " ", @_ );
210             }
211              
212             sub format_binary
213             {
214 0     0 0   my $self = shift;
215 0           my ( $bin ) = @_;
216              
217             # TODO: A global option to pick the format here
218 0           return "base64::" . do { local $_ = encode_base64( $bin, "" ); s/=+$//; $_ };
  0            
  0            
  0            
219             }
220              
221             sub format_hostport
222             {
223 0     0 0   my $self = shift;
224 0           my ( $host, $port ) = @_;
225              
226 0 0         return "[$host]:$port" if $host =~ m/:/; # IPv6
227 0           return "$host:$port";
228             }
229              
230             sub format_addr
231             {
232 0     0 0   my $self = shift;
233 0           my ( $addr ) = @_;
234 0           my ( $err, $host, $port ) = getnameinfo( $addr, NI_NUMERICHOST|NI_NUMERICSERV );
235 0 0         $err and die $err;
236              
237 0           return $self->format_hostport( $host, $port );
238             }
239              
240             sub error
241             {
242 0     0 0   my $self = shift;
243 0           print STDERR @_, "\n";
244              
245 0           return 1;
246             }
247              
248             ## Command support
249              
250             sub federation
251             {
252 0     0 0   my $self = shift;
253              
254 0   0       return $self->{federation} ||= Protocol::Matrix::HTTP::Federation->new;
255             }
256              
257             sub http_client
258             {
259 0     0 0   my $self = shift;
260              
261 0   0       return $self->{http_client} ||= do {
262 0           require App::MatrixTool::HTTPClient;
263             App::MatrixTool::HTTPClient->new(
264             family => $self->sock_family,
265 0           map { $_ => $self->{$_} } qw( print_request print_response ),
  0            
266             );
267             };
268             }
269              
270 0     0 0   sub server_key_store_path { "$ENV{HOME}/.matrix/server-keys" }
271              
272             sub server_key_store
273             {
274 0     0 0   my $self = shift;
275              
276 0   0       return $self->{server_key_store} ||= do {
277 0           require App::MatrixTool::ServerIdStore;
278 0           App::MatrixTool::ServerIdStore->new(
279             path => $self->server_key_store_path
280             );
281             };
282             }
283              
284 0     0 0   sub client_token_store_path { "$ENV{HOME}/.matrix/client-tokens" }
285              
286             sub client_token_store
287             {
288 0     0 0   my $self = shift;
289              
290 0   0       return $self->{client_token_store} ||= do {
291 0           require App::MatrixTool::ServerIdStore;
292 0           App::MatrixTool::ServerIdStore->new(
293             path => $self->client_token_store_path,
294             encode => "raw", # client tokens are already base64 encoded
295             );
296             };
297             }
298              
299             ## Builtin commands
300              
301             package
302             App::MatrixTool::Command::help;
303 1     1   8 use base qw( App::MatrixTool );
  1         1  
  1         73  
304              
305 1     1   5 use List::Util qw( max );
  1         2  
  1         68  
306              
307 1     1   3 use constant DESCRIPTION => "Display help information about commands";
  1         1  
  1         68  
308 1     1   4 use constant ARGUMENTS => ( "command...?" );
  1         1  
  1         41  
309              
310 1     1   3 use Struct::Dumb qw( readonly_struct );
  1         1  
  1         6  
311             readonly_struct CommandSpec => [qw( name description argspecs optspecs package )];
312              
313             sub commands
314             {
315 0     0     my $mp = Module::Pluggable::Object->new(
316             require => 1,
317             search_path => [ "App::MatrixTool::Command" ],
318             );
319              
320 0           my @commands;
321              
322 0           foreach my $module ( sort $mp->plugins ) {
323 0 0         $module->can( "DESCRIPTION" ) or next;
324              
325 0           my $cmd = $module;
326 0           $cmd =~ s/^App::MatrixTool::Command:://;
327 0           $cmd =~ s/_/-/g;
328 0           $cmd =~ s/::/ /g;
329              
330 0 0         push @commands, CommandSpec(
331             $cmd,
332             $module->DESCRIPTION,
333             [ $module->ARGSPECS ],
334             $module->can( "OPTIONS" ) ? [ $module->OPTSPECS ] : undef,
335             $module,
336             );
337             }
338              
339 0           return @commands;
340             }
341              
342             my $GLOBAL_OPTS = <<'EOF';
343             Global options:
344             -4 --inet4 Use only IPv4
345             -6 --inet6 Use only IPv6
346             --print-request Print sent HTTP requests in full
347             --print-response Print received HTTP responses in full
348             EOF
349              
350             sub help_summary
351             {
352 0     0     my $self = shift;
353              
354 0           $self->output( <<'EOF' . $GLOBAL_OPTS );
355             matrixtool [] []
356              
357             EOF
358              
359 0           my @commands = $self->commands;
360              
361 0           my $namelen = max map { length $_->name } @commands;
  0            
362              
363             $self->output( "Commands:\n" .
364 0           join "\n", map { sprintf " %-*s %s", $namelen, $_->name, $_->description } @commands
  0            
365             );
366             }
367              
368             sub _argdesc
369             {
370 0     0     shift;
371 0           my ( $argspec ) = @_;
372 0           my $name = $argspec->print_name;
373 0 0         return $argspec->optional ? "[$name]" : $name;
374             }
375              
376             sub _optdesc
377             {
378 0     0     my ( $optspec, $namelen ) = @_;
379              
380 0           my $shortname = $optspec->shortname;
381              
382 0 0         join "",
383             ( defined $shortname ? "-$shortname " : " " ),
384             sprintf( "--%-*s", $namelen, $optspec->print_name ),
385             " ",
386             $optspec->description,
387             }
388              
389             sub help_detailed
390             {
391 0     0     my $self = shift;
392 0           my ( $cmd ) = @_;
393              
394 0           my $pkg = App::MatrixTool->_pkg_for_command( $cmd );
395 0 0         $pkg->can( "new" ) or
396             return $self->error( "No such command '$cmd'" );
397              
398 0           my @argspecs = $pkg->ARGSPECS;
399              
400 0           $self->output( join " ", "matrixtool",
401             "[]",
402             $cmd,
403             ( map $self->_argdesc($_), @argspecs ),
404             "[]"
405             );
406 0           $self->output( $pkg->DESCRIPTION );
407 0           $self->output();
408              
409 0           $self->output( $GLOBAL_OPTS );
410              
411 0 0         if( $pkg->can( "OPTIONS" ) ) {
412 0           my @optspecs = $pkg->OPTSPECS;
413              
414 0           my $namelen = max map { length $_->name } @optspecs;
  0            
415              
416 0           $self->output( "Options:" );
417 0           foreach my $optspec ( sort { $a->name cmp $b->name } @optspecs ) {
  0            
418 0           $self->output( " " . _optdesc( $optspec, $namelen ) );
419             }
420 0           $self->output();
421             }
422             }
423              
424             sub run
425             {
426 0     0     my $self = shift;
427 0           my ( @cmd ) = @_;
428              
429 0 0         if( @cmd ) {
430 0           $self->help_detailed( join "::", @cmd );
431             }
432             else {
433 0           $self->help_summary;
434             }
435             }
436              
437             =head1 AUTHOR
438              
439             Paul Evans
440              
441             =cut
442              
443             0x55AA;