1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
|
# -*- cperl -*-
use ExtUtils::testlib;
use Test::More ;
use Config::Model ;
use Config::Model::BackendMgr; # required for tests
use Config::Model::Tester::Setup qw/init_test setup_test_dir/;
use English;
use Test::Differences ;
use Test::Warn ;
use warnings;
use strict;
my ($model, $trace) = init_test();
# pseudo root where config files are written by config-model
my $wr_root = setup_test_dir;
my $ssh_subdir = $^O eq 'darwin' ? '/etc'
: '/etc/ssh' ;
my $ssh_path = $wr_root->child($ssh_subdir);
my @orig = <DATA> ;
$ssh_path->mkpath;
my $ssh_file = $ssh_path->child('ssh_config');
$ssh_file->spew(@orig);
# special global variable used only for tests
my $joe_home = $^O eq 'darwin' ? '/Users/joe'
: '/home/joe' ; ;
Config::Model::BackendMgr::_set_test_home($joe_home) ;
# set up Joe's environment
my $joe_ssh = $wr_root->child($joe_home.'/.ssh');
$joe_ssh->mkpath;
my $joe_config = $joe_ssh->child('config');
$joe_config->spew("Host mine.bar\n\nIdentityFile ~/.ssh/mine\n") ;
sub read_user_ssh {
my $file = shift ;
my @res = grep {/\w/} map { chomp; s/\s+/ /g; $_ ;} grep { not /##/ } $file->lines ;
return @res ;
}
print "Test from directory $wr_root\n" if $trace ;
note "Running test like root (no layered config)" ;
my $root_inst = $model->instance (
root_class_name => 'SystemSsh',
instance_name => 'root_ssh_instance',
root_dir => $wr_root,
);
ok($root_inst,"Read $ssh_file and created instance") ;
my $root_cfg = $root_inst -> config_root ;
$root_cfg->init ;
my $dump = $root_cfg->dump_tree ();
print $dump if $trace ;
like($dump,qr/^#"ssh global comment"/, "check global comment pattern") ;
like($dump,qr/Ciphers=aes192-cbc,aes128-cbc,3des-cbc,blowfish-cbc,aes256-cbc#" Protocol 2,1\s+Cipher 3des"/,"check Ciphers comment");
like($dump,qr/SendEnv#" PermitLocalCommand no"/,"check SendEnv comment");
like($dump,qr/Host:"foo\.\*,\*\.bar"/, "check Host pattern") ;
like($dump,qr/LocalForward:0\s+port=20022/, "check user LocalForward port") ;
like($dump,qr/host=10.3.244.4/, "check user LocalForward host") ;
like($dump,qr/LocalForward:1#"IPv6 example"\s+ipv6=1/, "check user LocalForward ipv6") ;
like($dump,qr/port=22080/, "check user LocalForward port ipv6") ;
like($dump,qr/host=2001:0db8:85a3:0000:0000:8a2e:0370:7334/,
"check user LocalForward host ipv6") ;
$root_inst->write_back() ;
ok(1,"wrote ssh_config data in $wr_root") ;
my $inst2 = $model->instance (
root_class_name => 'SystemSsh',
instance_name => 'root_ssh_instance2',
root_dir => $wr_root,
);
my $root2 = $inst2 -> config_root ;
my $dump2 = $root2 -> dump_tree ();
print $dump2 if $trace ;
is_deeply([split /\n/,$dump2],[split /\n/,$dump],
"check if both root_ssh dumps are identical") ;
SKIP: {
skip "user tests when test is run as root", 12
if $EUID == 0 ;
note "Running test like user with layered config";
my $user_inst = $model->instance (
root_class_name => 'Ssh',
instance_name => 'user_ssh_instance',
root_dir => $wr_root,
);
ok($user_inst,"Read user .ssh/config and created instance") ;
my @joe_orig = read_user_ssh($joe_config) ;
my $user_cfg = $user_inst -> config_root ;
$dump = $user_cfg->dump_tree (mode => 'full' );
print $dump if $trace ;
like($dump,qr/Host:"foo\.\*,\*\.bar"/,"check root Host pattern") ;
like($dump,qr/Host:"?mine.bar"?/,"check user Host pattern") ;
$user_inst->write_back() ;
ok(1,"wrote user .ssh/config data in $joe_config") ;
ok($joe_config->is_file,"Found $joe_config") ;
# compare original and written file
my @joe_written = read_user_ssh($joe_config) ;
eq_or_diff(\@joe_written,\@joe_orig,"check user .ssh/config files") ;
# write some data
$user_cfg->load('EnableSSHKeysign=1') ;
$user_inst->write_back() ;
unshift @joe_orig,'EnableSSHKeysign yes';
@joe_written = read_user_ssh($joe_config) ;
eq_or_diff(\@joe_written,\@joe_orig,"check user .ssh/config files after modif") ;
# run test on tricky element
warning_like {
$user_inst->load( check => 'skip', step => 'Host:"*" IPQoS="foo bar baz"') ;
} qr/skipping value/ ,"too many fields warning";
warning_like {
$user_inst->load( check => 'skip', step => 'Host:"*" IPQoS="foo"') ;
} qr/skipping/ ,"bad fields warning";
ok($user_inst->has_error,"check errors count") ;
like($user_inst->error_messages,qr/"af11"/,"check error message") ;
$user_inst->load('Host:"*" IPQoS="af11 af12"') ;
# fix is pending
my $expect = $Config::Model::VERSION > 2.046 ? 0 : 1 ;
is($user_inst->has_error,$expect,"check error count after fix") ;
# check if config has warnings
is($user_inst->has_warning,0,"check if warnings are left");
}
done_testing;
__END__
# ssh global comment
Host *
# ForwardAgent no
# ForwardX11 no
Port 1022
# Protocol 2,1
# Cipher 3des
Ciphers aes192-cbc,aes128-cbc,3des-cbc,blowfish-cbc,aes256-cbc
# PermitLocalCommand no
SendEnv LANG LC_*
HashKnownHosts yes
GSSAPIAuthentication yes
GSSAPIDelegateCredentials no
# foo bar big
# comment
Host foo.*,*.bar
# for and bar have X11
ForwardX11 yes
SendEnv FOO BAR
Host *.gre.hp.com
ForwardX11 yes
User tester
Host picosgw
ForwardAgent yes
HostName sshgw.truc.bidule
IdentityFile ~/.ssh/%r
LocalForward 20022 10.3.244.4:22
# IPv6 example
LocalForward all.com/22080 2001:0db8:85a3:0000:0000:8a2e:0370:7334/80
User k0013
Host picos
ForwardX11 yes
HostName localhost
Port 20022
User ocad
ControlPersist YES
|
