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   41300 use strict;
  2         4  
  2         58  
11 2     2   10 use warnings;
  2         4  
  2         96  
12              
13             $Config::Model::Backend::OpenSsh::Ssh::VERSION = '2.9.0.1';
14             use Mouse ;
15 2     2   12 use 5.10.1;
  2         4  
  2         15  
16 2     2   1030 extends "Config::Model::Backend::Any" ;
  2         7  
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   10 use IO::File ;
  2         5  
  2         105  
26 2     2   804 use Log::Log4perl;
  2         3291  
  2         214  
27 2     2   11 use File::Copy ;
  2         3  
  2         12  
28 2     2   470 use File::Path ;
  2         1970  
  2         107  
29 2     2   14 use File::HomeDir ;
  2         4  
  2         87  
30 2     2   10  
  2         3  
  2         1536  
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 3768258 }
36 8         70  
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 138  
42 43         247 $logger->info("ssh: load host patterns '".join("','", @$patterns)."'");
43 43         375 my $hv = $hash_obj->fetch_with_id("@$patterns") ;
44             $hv -> annotation($comment) if $comment ;
45 43         73430  
46 43         457 $self->current_node($hv);
47 43 100       169221 }
48              
49 43         940 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 64 my $elt_name = $key =~ /local/i ? 'Localforward' : 'RemoteForward' ;
54 18         134  
55 18 50       178 my $v6 = ($args->[1] =~ m![/\[\]]!) ? 1 : 0;
56              
57 18 50       101 $logger->info("ssh: load $key '".join("','", @$args)."' ". ( $v6 ? 'IPv6' : 'IPv4'));
58              
59 18 100       90 # cleanup possible square brackets used for IPv6
60             foreach (@$args) {
61 18 100       132 s/[\[\]]+//g;
62             }
63              
64 18         129 # reverse enable to assign string to port even if no bind_adress
65 36         99 # 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       88 my $fw_list = $self->current_node->fetch_element($key);
71 18         143 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         88  
75 18         4506 # $fw_obj->store_element_value( GatewayPorts => 1 ) if $bind_adr ;
76             $fw_obj->annotation($comment) if $comment;
77 18         145  
78             $fw_obj->store_element_value( ipv6 => 1) if $v6 ;
79              
80 18 100       15754 $fw_obj->store_element_value( check => $check, name => 'bind_address', value => $bind_adr)
81             if defined $bind_adr ;
82 18 100       649 $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       7526 $fw_obj->store_element_value( check => $check, name => 'hostport', value => $host_port );
85              
86 18         7139 }
87 18         16958  
88 18         13716 my $self = shift ;
89             my $host_elt = shift ;
90             my $mode = shift || '';
91              
92             my $result = '' ;
93 8     8 0 23  
94 8         27 foreach my $pattern ( $host_elt->fetch_all_indexes) {
95 8   50     29 my $block_elt = $host_elt->fetch_with_id($pattern) ;
96             $logger->debug("write_all_host_block on ".$block_elt->location." mode $mode");
97 8         19 my $block_data = $self->write_node_content($block_elt,'custom') ;
98              
99 8         42 # write data only if custom pattern or custom data is found this
100 14         211 # is necessary to avoid writing data from /etc/ssh/ssh_config that
101 14         915 # were entered as 'preset' data
102 14         127 if ($block_data) {
103             $result .= $self->write_line(Host => $pattern, $block_elt->annotation);
104             $result .= "$block_data\n" ;
105             }
106             }
107 14 50       38 return $result ;
108 14         46 }
109 14         358  
110             my $self = shift ;
111             my $forward_elt = shift ;
112 8         139 my $mode = shift || '';
113              
114             my $result = '' ;
115              
116 6     6 0 13 my $v6 = $forward_elt->grab_value('ipv6') ;
117 6         12 my $sep = $v6 ? '/' : ':';
118 6   50     23  
119             my $line = '';
120 6         13 foreach my $name ($forward_elt->get_element_name() ) {
121             next if $name eq 'ipv6' ;
122 6         28 my $elt = $forward_elt->fetch_element($name) ;
123 6 100       3482 my $v = $elt->fetch($mode) ;
124             next unless length($v);
125 6         13 $line
126 6         20 .= $name =~ /bind|host$/ ? "$v$sep"
127 30 100       673 : $name eq 'port' ? "$v "
128 24         61 : $v ;
129 24         1480 }
130 24 100       4680  
131 21 100       148 return $self->write_line($forward_elt->element_name,$line,$forward_elt->annotation) ;
    100          
132             }
133              
134             no Mouse;
135              
136             1;
137 6         37  
138             # ABSTRACT: Backend for ssh configuration files
139              
140 2     2   22  
  2         3  
  2         16  
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.1
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