File Coverage

blib/lib/Config/Model/Backend/OpenSsh/Ssh.pm
Criterion Covered Total %
statement 87 87 100.0
branch 27 30 90.0
condition 2 4 50.0
subroutine 16 16 100.0
pod 1 5 20.0
total 133 142 93.6


line stmt bran cond sub pod time code
1             #
2             # This file is part of Config-Model-OpenSsh
3             #
4             # This software is Copyright (c) 2008-2022 by Dominique Dumont.
5             #
6             # This is free software, licensed under:
7             #
8             # The GNU Lesser General Public License, Version 2.1, February 1999
9             #
10 2     2   43462 use strict;
  2         7  
  2         61  
11 2     2   10 use warnings;
  2         5  
  2         119  
12              
13             $Config::Model::Backend::OpenSsh::Ssh::VERSION = '2.9.0.2';
14             use Mouse ;
15 2     2   11 use 5.10.1;
  2         5  
  2         15  
16 2     2   996 extends "Config::Model::Backend::Any" ;
  2         5  
17              
18             with (
19             'Config::Model::Backend::OpenSsh::Role::Reader',
20             'Config::Model::Backend::OpenSsh::Role::Writer',
21             );
22              
23              
24             use Carp ;
25 2     2   12 use IO::File ;
  2         3  
  2         129  
26 2     2   766 use Log::Log4perl;
  2         3318  
  2         229  
27 2     2   18 use File::Copy ;
  2         3  
  2         20  
28 2     2   461 use File::Path ;
  2         1893  
  2         109  
29 2     2   13 use File::HomeDir ;
  2         5  
  2         82  
30 2     2   10  
  2         4  
  2         1663  
31             my $logger = Log::Log4perl::get_logger("Backend::OpenSsh");
32              
33             my $self = shift;
34             $self->ssh_write(@_, ssh_mode => 'custom') ;
35 8     8 1 3883756 }
36 8         60  
37              
38             my ($self,$root,$key, $patterns,$comment) = @_;
39             $logger->debug("host: pattern @$patterns # $comment");
40             my $hash_obj = $root->fetch_element('Host');
41 43     43 0 159  
42 43         257 $logger->info("ssh: load host patterns '".join("','", @$patterns)."'");
43 43         414 my $hv = $hash_obj->fetch_with_id("@$patterns") ;
44             $hv -> annotation($comment) if $comment ;
45 43         74328  
46 43         479 $self->current_node($hv);
47 43 100       174278 }
48              
49 43         964 my ($self, $root, $key, $args, $comment, $check) = @_;
50             $logger->debug("forward: $key @$args # $comment");
51             $self->current_node = $root unless defined $self->current_node ;
52              
53 18     18 0 71 my $elt_name = $key =~ /local/i ? 'Localforward' : 'RemoteForward' ;
54 18         159  
55 18 50       259 my $v6 = ($args->[1] =~ m![/\[\]]!) ? 1 : 0;
56              
57 18 50       110 $logger->info("ssh: load $key '".join("','", @$args)."' ". ( $v6 ? 'IPv6' : 'IPv4'));
58              
59 18 100       96 # cleanup possible square brackets used for IPv6
60             foreach (@$args) {
61 18 100       156 s/[\[\]]+//g;
62             }
63              
64 18         138 # reverse enable to assign string to port even if no bind_adress
65 36         97 # is specified
66             my $re = $v6 ? qr!/! : qr!:! ;
67             my ($port,$bind_adr ) = reverse split $re,$args->[0] ;
68             my ($host,$host_port) = split $re,$args->[1] ;
69              
70 18 100       95 my $fw_list = $self->current_node->fetch_element($key);
71 18         163 my $size = $fw_list->fetch_size;
72 18         109 # this creates a new node in the list
73             my $fw_obj = $fw_list->fetch_with_id($size);
74 18         94  
75 18         5266 # $fw_obj->store_element_value( GatewayPorts => 1 ) if $bind_adr ;
76             $fw_obj->annotation($comment) if $comment;
77 18         155  
78             $fw_obj->store_element_value( ipv6 => 1) if $v6 ;
79              
80 18 100       17594 $fw_obj->store_element_value( check => $check, name => 'bind_address', value => $bind_adr)
81             if defined $bind_adr ;
82 18 100       702 $fw_obj->store_element_value( check => $check, name => 'port', value => $port );
83             $fw_obj->store_element_value( check => $check, name => 'host', value => $host );
84 18 100       8186 $fw_obj->store_element_value( check => $check, name => 'hostport', value => $host_port );
85              
86 18         7141 }
87 18         17501  
88 18         14371 my $self = shift ;
89             my $host_elt = shift ;
90             my $mode = shift || '';
91              
92             my $result = '' ;
93 8     8 0 21  
94 8         18 foreach my $pattern ( $host_elt->fetch_all_indexes) {
95 8   50     30 my $block_elt = $host_elt->fetch_with_id($pattern) ;
96             $logger->debug("write_all_host_block on ".$block_elt->location." mode $mode");
97 8         31 my $block_data = $self->write_node_content($block_elt,'custom') ;
98              
99 8         39 # write data only if custom pattern or custom data is found this
100 14         262 # is necessary to avoid writing data from /etc/ssh/ssh_config that
101 14         1164 # were entered as 'preset' data
102 14         156 if ($block_data) {
103             $result .= $self->write_line(Host => $pattern, $block_elt->annotation);
104             $result .= "$block_data\n" ;
105             }
106             }
107 14 50       73 return $result ;
108 14         100 }
109 14         380  
110             my $self = shift ;
111             my $forward_elt = shift ;
112 8         114 my $mode = shift || '';
113              
114             my $result = '' ;
115              
116 6     6 0 17 my $v6 = $forward_elt->grab_value('ipv6') ;
117 6         12 my $sep = $v6 ? '/' : ':';
118 6   50     22  
119             my $line = '';
120 6         11 foreach my $name ($forward_elt->get_element_name() ) {
121             next if $name eq 'ipv6' ;
122 6         35 my $elt = $forward_elt->fetch_element($name) ;
123 6 100       3807 my $v = $elt->fetch($mode) ;
124             next unless length($v);
125 6         12 $line
126 6         28 .= $name =~ /bind|host$/ ? "$v$sep"
127 30 100       794 : $name eq 'port' ? "$v "
128 24         59 : $v ;
129 24         1483 }
130 24 100       4209  
131 21 100       167 return $self->write_line($forward_elt->element_name,$line,$forward_elt->annotation) ;
    100          
132             }
133              
134             no Mouse;
135              
136             1;
137 6         41  
138             # ABSTRACT: Backend for ssh configuration files
139              
140 2     2   16  
  2         4  
  2         23  
141             =pod
142              
143             =encoding UTF-8
144              
145             =head1 NAME
146              
147             Config::Model::Backend::OpenSsh::Ssh - Backend for ssh configuration files
148              
149             =head1 VERSION
150              
151             version 2.9.0.2
152              
153             =head1 SYNOPSIS
154              
155             None
156              
157             =head1 DESCRIPTION
158              
159             This module provides a backend to read and write ssh client configuration files.
160              
161             =head1 STOP
162              
163             The documentation provides details on the module used to read and
164             write OpenSsh configuration files. These details are not needed for
165             the basic usages explained in L<Config::Model::OpenSsh>.
166              
167             =head1 Methods
168              
169             These read/write functions are part of C<OpenSsh::Ssh> read/write
170             backend. They are declared in Ssh configuration model and are called
171             back when needed to read and write the configuration file.
172              
173             =head2 read (object => <ssh_root>, config_dir => ...)
174              
175             Reads F<ssh_config> in C<config_dir> and load the data in the
176             C<ssh_root> configuration tree.
177              
178             =head2 write (object => <ssh_root>, config_dir => ...)
179              
180             Write F<ssh_config> in C<config_dir> from the data stored in
181             C<ssh_root> configuration tree.
182              
183             =head1 SEE ALSO
184              
185             L<cme>, L<Config::Model>, L<Config::Model::OpenSsh>
186              
187             =head1 AUTHOR
188              
189             Dominique Dumont
190              
191             =head1 COPYRIGHT AND LICENSE
192              
193             This software is Copyright (c) 2008-2022 by Dominique Dumont.
194              
195             This is free software, licensed under:
196              
197             The GNU Lesser General Public License, Version 2.1, February 1999
198              
199             =cut