Commit fresh-snapshots/main - libconfig-model-backend-augeas-perl

New upstream snapshot. Debian Janitor 2 years ago

13 changed file(s) with 418 addition(s) and 499 deletion(s). Raw diff Collapse all Expand all

-1

Build.PL less more

41	41	build_requires => {
42	42	'Config::Model' => '2.117',
43	43	'Config::Model::Itself' => '2.012', # for t/model_extension.t
44		'Config::Model::Tester' => '3.006', # for init_test() calls
45	44	'Test::More' => 0,
46	45	'Test::Exception' => 0,
47	46	'Test::Differences' => 0,

-6

ChangeLog less more

0		2018-02-26 Dominique Dumont <domi.dumont@free.fr> v0.125
1
2		* fix wiki url
3		* remove mentions of sourceforge mailing list
4		* use init_test during tests (require Config::Model::Tester 3.006)
5
6	0	2018-02-26 Dominique Dumont <domi.dumont@free.fr> v0.124
7	1
8	2	* Handle backend parameter based on Path::Tiny that were

-1

MANIFEST less more

12	12	t/model_extension.t
13	13	t/pod.t
14	14	t/test_model.pl
15		t/lib/LoadTest.pm

-3

META.json less more

17	17	"requires" : {
18	18	"Config::Model" : "2.117",
19	19	"Config::Model::Itself" : "2.012",
20		"Config::Model::Tester" : "3.006",
21	20	"Test::Differences" : "0",
22	21	"Test::Exception" : "0",
23	22	"Test::More" : "0",

42	41	"provides" : {
43	42	"Config::Model::Backend::Augeas" : {
44	43	"file" : "lib/Config/Model/Backend/Augeas.pm",
45		"version" : "0.125"
	44	"version" : "0.124"
46	45	}
47	46	},
48	47	"release_status" : "stable",

51	50	"http://www.gnu.org/licenses/old-licenses/lgpl-2.1.txt"
52	51	]
53	52	},
54		"version" : "0.125",
	53	"version" : "0.124",
55	54	"x_serialization_backend" : "JSON::PP version 4.04"
56	55	}

-3

META.yml less more

4	4	build_requires:
5	5	Config::Model: '2.117'
6	6	Config::Model::Itself: '2.012'
7		Config::Model::Tester: '3.006'
8	7	Test::Differences: '0'
9	8	Test::Exception: '0'
10	9	Test::More: '0'

22	21	provides:
23	22	Config::Model::Backend::Augeas:
24	23	file: lib/Config/Model/Backend/Augeas.pm
25		version: '0.125'
	24	version: '0.124'
26	25	requires:
27	26	Config::Augeas: '0.303'
28	27	Config::Model: '2.117'

30	29	Mouse: '0'
31	30	resources:
32	31	license: http://www.gnu.org/licenses/old-licenses/lgpl-2.1.txt
33		version: '0.125'
	32	version: '0.124'
34	33	x_serialization_backend: 'CPAN::Meta::YAML version 0.018'

-1

README less more

34	34
35	35	For more details on Config::Model see:
36	36
37		https://github.com/dod38fr/config-model/wiki
	37	http://config-model.wiki.sourceforge.net/
38	38
39	39	For more details on Augeas, see:
40	40

-0

debian/changelog less more

	0	libconfig-model-backend-augeas-perl (0.125+git20200222.1.45dad99-1) UNRELEASED; urgency=low
	1
	2	* New upstream snapshot.
	3
	4	-- Debian Janitor <janitor@jelmer.uk> Sun, 06 Jun 2021 07:54:49 -0000
	5
0	6	libconfig-model-backend-augeas-perl (0.125-1) unstable; urgency=medium
1	7
2	8	* Team upload.

-4

lib/Config/Model/Backend/Augeas.pm less more

32	32	eval { require Config::Augeas; };
33	33	$has_augeas = 0 if $@;
34	34
35		our $VERSION = '0.125';
	35	our $VERSION = '0.124';
36	36
37	37	my $logger = get_logger('Backend::Augeas');
	38
	39	sub suffix { return ''; }
38	40
39	41	=head1 NAME
40	42

751	753
752	754	=item *
753	755
754		config-model wiki: L<http://github.com/dod38fr/config-model/wiki>
	756	L<Config::Model>
755	757
756	758	=item *
757	759
758		Blogs about this project: L<https://ddumont.wordpress.com/category/perl/configmodel/>
	760	Augeas mailing list: http://augeas.net/developers.html
759	761
760	762	=item *
761	763
762		Augeas mailing list: http://augeas.net/developers.html
	764	Config::Model mailing list : http://sourceforge.net/mail/?group_id=155650
763	765
764	766	=back
765	767

+156

-116

t/augeas_backend.t less more

12	12	use Test::More ;
13	13	use Test::Differences;
14	14	use Config::Model;
15		use Config::Model::Tester::Setup qw/init_test setup_test_dir/;
16		use Path::Tiny;
	15	use File::Path;
	16	use File::Copy ;
17	17	use version 0.77 ;
18
19		use lib 't/lib';
20		use LoadTest;
	18	use Log::Log4perl qw(:easy :levels);
21	19
22	20	use warnings;
	21	no warnings qw(once);
	22
23	23	use strict;
	24
	25	use vars qw/$model/;
	26
	27	my $arg = shift \|\| '';
	28	my ( $trace, $log, $show ) = (0) x 3;
	29
	30	$log = 1 if $arg =~ /l/;
	31	$show = 1 if $arg =~ /s/;
	32	$trace = 1 if $arg =~ /t/ ;
	33	Config::Model::Exception::Any->Trace(1) if $arg =~ /e/;
	34
	35	my $home = $ENV{HOME} \|\| "";
	36	my $log4perl_user_conf_file = "$home/.log4config-model";
	37
	38	if ( $log and -e $log4perl_user_conf_file ) {
	39	Log::Log4perl::init($log4perl_user_conf_file);
	40	}
	41	else {
	42	Log::Log4perl->easy_init( $log ? $WARN : $ERROR );
	43	}
	44
	45	$model = Config::Model -> new (legacy => 'ignore',) ;
24	46
25	47	eval { require Config::Augeas ;} ;
26	48	if ( $@ ) {

30	52	plan tests => 18;
31	53	}
32	54
33		my ($model, $trace) = init_test();
	55	ok(1,"compiled");
34	56
35	57	# pseudo root were input config file are read
36		my $r_root = path('augeas-box');
	58	my $r_root = 'augeas-box/';
37	59
38	60	# pseudo root where config files are written by config-model
39		my $wr_root = setup_test_dir;
	61	my $wr_root = 'wr_root/';
40	62
41	63	# cleanup before tests
42		$wr_root->child('etc/ssh')->mkpath;
43		$r_root->child('etc/hosts')->copy($wr_root->child('etc')) ;
44		$r_root->child('etc/ssh/sshd_config')->copy($wr_root->child('etc/ssh/')) ;
	64	rmtree($wr_root);
	65	mkpath($wr_root.'etc/ssh/', { mode => 0755 }) ;
	66	copy($r_root.'etc/hosts',$wr_root.'etc/') ;
	67	copy($r_root.'etc/ssh/sshd_config',$wr_root.'etc/ssh/') ;
45	68
46	69	# set_up data
47		load_test_model($model);
48
49		my $i_hosts = $model->instance(
50		instance_name => 'hosts_inst',
51		root_class_name => 'Hosts',
52		root_dir => $wr_root ,
53		);
	70	do "./t/test_model.pl" ;
	71
	72	my $i_hosts = $model->instance(instance_name => 'hosts_inst',
	73	root_class_name => 'Hosts',
	74	root_dir => $wr_root ,
	75	);
54	76
55	77	ok( $i_hosts, "Created instance for /etc/hosts" );
56	78

81	103	$i_hosts->write_back ;
82	104	ok(1,"/etc/hosts write back done") ;
83	105
84		my $aug_file = $wr_root->child('etc/hosts');
85		my $aug_save_file = $aug_file->parent->child('hosts.augsave') ;
86		ok($aug_save_file->is_file, "check that backup config file $aug_save_file was written");
87
88		my @expect = (
89		"192.168.0.1 buildbot\n",
90		"192.168.0.10\tkomarr\n",
91		"192.168.0.11\trepoman\n",
92		"192.168.0.111\tgoner\n"
93		);
94
95		is_deeply([$aug_file->lines],\@expect,"check content of $aug_file") ;
	106	my $aug_file = $wr_root.'etc/hosts';
	107	my $aug_save_file = $aug_file.'.augsave' ;
	108	ok(-e $aug_save_file, "check that backup config file $aug_save_file was written");
	109
	110	my @expect = ("192.168.0.1 buildbot\n",
	111	"192.168.0.10\tkomarr\n",
	112	"192.168.0.11\trepoman\n",
	113	"192.168.0.111\tgoner\n"
	114	);
	115
	116	open(AUG,$aug_file) \|\| die "Can't open $aug_file:$!";
	117	is_deeply([<AUG>],\@expect,"check content of $aug_file") ;
	118	close AUG;
96	119
97	120	# check directly the content of augeas
98	121	my $augeas_obj = $i_root->backend_mgr->backend_obj->_augeas_object ;

109	132	is($nb,3,"Check nb of hosts in Augeas after deletion") ;
110	133
111	134	pop @expect; # remove goner entry
112		is_deeply([$aug_file->lines],\@expect,"check content of $aug_file after deletion of goner") ;
	135	open(AUG,$aug_file) \|\| die "Can't open $aug_file:$!";
	136	is_deeply([<AUG>],\@expect,"check content of $aug_file after deletion of goner") ;
	137	close AUG;
113	138
114	139	$augeas_obj->print('/') if $trace;
115	140

126	151	SKIP: {
127	152	skip $skip , 8 if $skip ;
128	153
129		my $i_sshd = $model->instance(
130		instance_name => 'sshd_inst',
131		root_class_name => 'Sshd',
132		root_dir => $wr_root ,
133		);
134
135		ok( $i_sshd, "Created instance for sshd" );
136
137		ok( $i_sshd, "Created instance for /etc/ssh/sshd_config" );
138
139		my $sshd_config = $wr_root->child('etc/ssh/sshd_config');
140		my @sshd_orig = $sshd_config->lines ;
141
142		my $sshd_root = $i_sshd->config_root ;
143		$sshd_root->init; # required by Config::Model 1.236
144
145		my $ssh_augeas_obj = $sshd_root->backend_mgr->backend_obj->_augeas_object ;
146
147		$ssh_augeas_obj->print('/files/etc/ssh/sshd_config/*') if $trace;
148		#my @aug_content = $ssh_augeas_obj->match("/files/etc/ssh/sshd_config/*") ;
149		#print join("\n",@aug_content) ;
150
151		my $assign = $Config::Model::VERSION >= 2.052 ? ':=' : ':' ;
152
153		$expect = qq(AcceptEnv${assign}LC_PAPER,LC_NAME,LC_ADDRESS,LC_TELEPHONE,LC_MEASUREMENT,LC_IDENTIFICATION,LC_ALL
	154	my $i_sshd = $model->instance(instance_name => 'sshd_inst',
	155	root_class_name => 'Sshd',
	156	root_dir => $wr_root ,
	157	);
	158
	159	ok( $i_sshd, "Created instance for sshd" );
	160
	161	ok( $i_sshd, "Created instance for /etc/ssh/sshd_config" );
	162
	163	open(SSHD,"$wr_root/etc/ssh/sshd_config")
	164	\|\| die "can't open file: $!";
	165
	166	my @sshd_orig = <SSHD> ;
	167	close SSHD ;
	168
	169	my $sshd_root = $i_sshd->config_root ;
	170	$sshd_root->init; # required by Config::Model 1.236
	171
	172	my $ssh_augeas_obj = $sshd_root->backend_mgr->backend_obj->_augeas_object ;
	173
	174	$ssh_augeas_obj->print('/files/etc/ssh/sshd_config/*') if $trace;
	175	#my @aug_content = $ssh_augeas_obj->match("/files/etc/ssh/sshd_config/*") ;
	176	#print join("\n",@aug_content) ;
	177
	178	my $assign = $Config::Model::VERSION >= 2.052 ? ':=' : ':' ;
	179
	180	$expect = qq(AcceptEnv${assign}LC_PAPER,LC_NAME,LC_ADDRESS,LC_TELEPHONE,LC_MEASUREMENT,LC_IDENTIFICATION,LC_ALL
154	181	AllowUsers${assign}foo,"bar\@192.168.0.*"
155	182	HostbasedAuthentication=no
156	183	HostKey${assign}/etc/ssh/ssh_host_key,/etc/ssh/ssh_host_rsa_key,/etc/ssh/ssh_host_dsa_key

178	205	Ciphers=arcfour256,aes192-cbc,aes192-ctr,aes256-cbc,aes256-ctr -
179	206	);
180	207
181		$dump = $sshd_root->dump_tree ;
182		print $dump if $trace ;
183		eq_or_diff( [ split /\n/, $dump ] , [ split /\n/, $expect ] ,"check dump of augeas data");
184
185		# change data content, '~' is like a splice, 'record~0' like a "shift"
186		$sshd_root->load("HostbasedAuthentication=yes
	208	$dump = $sshd_root->dump_tree ;
	209	print $dump if $trace ;
	210	eq_or_diff( [ split /\n/, $dump ] , [ split /\n/, $expect ] ,"check dump of augeas data");
	211
	212	# change data content, '~' is like a splice, 'record~0' like a "shift"
	213	$sshd_root->load("HostbasedAuthentication=yes
187	214	Subsystem:ddftp=/home/dd/bin/ddftp
188	215	Subsystem~rftp
189	216	") ;
190	217
191		# augeas is broken somehow when reloading CIphers, let's delete this field
192		$sshd_root->fetch_element("Ciphers")->clear ;
193
194		$dump = $sshd_root->dump_tree ;
195		print $dump if $trace ;
196
197		$i_sshd->write_back ;
198
199		my $aug_save_sshd_file = $sshd_config->parent->child('sshd_config.augsave') ;
200		ok($aug_save_sshd_file -> is_file,
201		"check that backup config file $aug_save_sshd_file was written");
202
203		my @mod = @sshd_orig;
204		$mod[2] = "HostbasedAuthentication yes\n";
205		splice @mod, 8,0,"Protocol 1,2\n";
206
207		$mod[15] = "Subsystem ddftp /home/dd/bin/ddftp\n";
208		splice @mod,24,1 ; # remove Ciphers check because Augeas looks broken
209
210		eq_or_diff([$sshd_config->lines],\@mod,"check content of $sshd_config") ;
211
212		$sshd_root->load("Match~1") ;
213
214		$dump = $sshd_root->dump_tree ;
215		print $dump if $trace ;
216		$i_sshd->write_back ;
217
218		my $i=0;
219		print "mod--\n",map { $i++ . ': '. $_} @mod,"---\n" if $trace ;
220
221		my @lines = splice @mod,36,2 ;
222		splice @mod, 32,2, @lines ;
223		pop @mod ;
224
225		is_deeply([$sshd_config->lines],\@mod,"check content of $sshd_config after Match~1") ;
226
227		$sshd_root->load("Match:2 Condition User=sarko Group=pres.* -
	218	# augeas is broken somehow when reloading CIphers, let's delete this field
	219	$sshd_root->fetch_element("Ciphers")->clear ;
	220
	221	$dump = $sshd_root->dump_tree ;
	222	print $dump if $trace ;
	223
	224	$i_sshd->write_back ;
	225
	226	my $aug_sshd_file = $wr_root.'etc/ssh/sshd_config';
	227	my $aug_save_sshd_file = $aug_sshd_file.'.augsave' ;
	228	ok(-e $aug_save_sshd_file,
	229	"check that backup config file $aug_save_sshd_file was written");
	230
	231	my @mod = @sshd_orig;
	232	$mod[2] = "HostbasedAuthentication yes\n";
	233	splice @mod, 8,0,"Protocol 1,2\n";
	234
	235	$mod[15] = "Subsystem ddftp /home/dd/bin/ddftp\n";
	236	splice @mod,24,1 ; # remove Ciphers check because Augeas looks broken
	237
	238	open(AUG,$aug_sshd_file) \|\| die "Can't open $aug_sshd_file:$!";
	239	eq_or_diff([<AUG>],\@mod,"check content of $aug_sshd_file") ;
	240	close AUG;
	241
	242	$sshd_root->load("Match~1") ;
	243
	244	$dump = $sshd_root->dump_tree ;
	245	print $dump if $trace ;
	246	$i_sshd->write_back ;
	247
	248	my $i=0;
	249	print "mod--\n",map { $i++ . ': '. $_} @mod,"---\n" if $trace ;
	250
	251	my @lines = splice @mod,36,2 ;
	252	splice @mod, 32,2, @lines ;
	253	pop @mod ;
	254
	255	open(AUG,$aug_sshd_file) \|\| die "Can't open $aug_sshd_file:$!";
	256	is_deeply([<AUG>],\@mod,"check content of $aug_sshd_file after Match~1") ;
	257	close AUG;
	258
	259	$sshd_root->load("Match:2 Condition User=sarko Group=pres.* -
228	260	Settings Banner=/etc/bienvenue2.txt") ;
229	261
230		$i_sshd->write_back ;
231
232
233		push @mod,"Match User sarko Group pres.*\n","Banner /etc/bienvenue2.txt\n";
234
235		my @got = map {s/^[\t ]+//; $_; } $sshd_config->lines;
236		eq_or_diff(\@got,\@mod,"check content of $sshd_config after Match:2 ...") ;
237
238		$sshd_root->load("Match:2 Condition User=sarko Group=pres.* -
	262	$i_sshd->write_back ;
	263
	264
	265	push @mod,"Match User sarko Group pres.*\n","Banner /etc/bienvenue2.txt\n";
	266
	267
	268	open(AUG,$aug_sshd_file) \|\| die "Can't open $aug_sshd_file:$!";
	269	my @got = <AUG> ;
	270	map {s/^[\t ]+//;} @got;
	271	eq_or_diff(\@got,\@mod,"check content of $aug_sshd_file after Match:2 ...") ;
	272	close AUG;
	273
	274	$sshd_root->load("Match:2 Condition User=sarko Group=pres.* -
239	275	Settings AllowTcpForwarding=yes") ;
240	276
241		$i_sshd->write_back ;
242
243		$i=0;
244		print "mod--\n",map { $i++ . ': '. $_} @mod,"---\n" if $trace ;
245		splice @mod,37,0,"AllowTcpForwarding yes\n";
246
247		@got = map {s/^[\t ]+//; $_; } $sshd_config->lines;
248		eq_or_diff( \@got,\@mod,"check content of $sshd_config after Match:2 AllowTcpForwarding=yes") ;
	277	$i_sshd->write_back ;
	278
	279	$i=0;
	280	print "mod--\n",map { $i++ . ': '. $_} @mod,"---\n" if $trace ;
	281	splice @mod,37,0,"AllowTcpForwarding yes\n";
	282
	283	open(AUG,$aug_sshd_file) \|\| die "Can't open $aug_sshd_file:$!";
	284	@got = <AUG> ;
	285	map {s/^[\t ]+//;} @got;
	286	eq_or_diff( \@got,\@mod,"check content of $aug_sshd_file after Match:2 AllowTcpForwarding=yes") ;
	287	close AUG;
	288
249	289
250	290	} # end SKIP section

+49

-31

t/augeas_from_scratch.t less more

4	4	use ExtUtils::testlib;
5	5	use Test::More ;
6	6	use Config::Model 2.116;
7		use Config::Model::Tester::Setup qw/init_test setup_test_dir/;
8		use Path::Tiny;
	7	use File::Path;
	8	use File::Copy ;
9	9	use version 0.77 ;
10	10
11		use lib 't/lib';
12		use LoadTest;
	11	use warnings;
	12	no warnings qw(once);
13	13
14		use warnings;
15	14	use strict;
	15
	16	use vars qw/$model/;
16	17
17	18	# workaround Augeas locale bug
18	19	if (not defined $ENV{LC_ALL} or $ENV{LC_ALL} ne 'C' or $ENV{LANG} ne 'C') {

20	21	# use the Perl interpreter that ran this script. See RT #116750
21	22	exec("$^X $0 @ARGV");
22	23	}
	24
	25	my $arg = shift \|\| '';
	26
	27	my $trace = $arg =~ /t/ ? 1 : 0 ;
	28	$::verbose = 1 if $arg =~ /v/;
	29	$::debug = 1 if $arg =~ /d/;
	30	Config::Model::Exception::Any->Trace(1) if $arg =~ /e/;
	31
	32	use Log::Log4perl qw(:easy) ;
	33	Log::Log4perl->easy_init($arg =~ /l/ ? $TRACE: $WARN);
	34
	35	$model = Config::Model -> new (legacy => 'ignore',) ;
23	36
24	37	eval { require Config::Augeas ;} ;
25	38	if ( $@ ) {

29	42	plan tests => 4;
30	43	}
31	44
32		my ($model, $trace) = init_test();
	45	ok(1,"compiled");
33	46
34	47	# pseudo root where config files are written by config-model
35		my $wr_root = setup_test_dir;
	48	my $wr_root = 'wr_root/';
36	49
37	50	# cleanup before tests
38		$wr_root->child('etc/ssh')->mkpath;
	51	rmtree($wr_root);
	52	mkpath($wr_root.'etc/ssh/', { mode => 0755 }) ;
39	53
40	54	# set_up data
41		load_test_model($model);
	55	do "./t/test_model.pl" ;
42	56
43	57	my $have_pkg_config = `pkg-config --version` \|\| '';
44	58	chomp $have_pkg_config ;

53	67	SKIP: {
54	68	skip $skip , 3 if $skip ;
55	69
56		my $i_sshd = $model->instance(
57		instance_name => 'sshd_inst',
58		root_class_name => 'Sshd',
59		root_dir => $wr_root ,
60		);
	70	my $i_sshd = $model->instance(instance_name => 'sshd_inst',
	71	root_class_name => 'Sshd',
	72	root_dir => $wr_root ,
	73	);
61	74
62		ok( $i_sshd, "Created instance for sshd" );
	75	ok( $i_sshd, "Created instance for sshd" );
63	76
64		ok( $i_sshd, "Created instance for /etc/ssh/sshd_config" );
	77	ok( $i_sshd, "Created instance for /etc/ssh/sshd_config" );
65	78
66		my $sshd_root = $i_sshd->config_root ;
67		$sshd_root->init ;
	79	my $sshd_root = $i_sshd->config_root ;
	80	$sshd_root->init ;
68	81
69		my $ssh_augeas_obj = $sshd_root->backend_mgr->backend_obj->_augeas_object ;
	82	my $ssh_augeas_obj = $sshd_root->backend_mgr->backend_obj->_augeas_object ;
70	83
71		$ssh_augeas_obj->print('/files/etc/ssh/sshd_config/*') if $trace;
	84	$ssh_augeas_obj->print('/files/etc/ssh/sshd_config/*') if $trace;
	85	#my @aug_content = $ssh_augeas_obj->match("/files/etc/ssh/sshd_config/*") ;
	86	#print join("\n",@aug_content) ;
72	87
73		# change data content, '~' is like a splice, 'record~0' like a "shift"
74		$sshd_root->load("HostbasedAuthentication=yes
	88	# change data content, '~' is like a splice, 'record~0' like a "shift"
	89	$sshd_root->load("HostbasedAuthentication=yes
75	90	Subsystem:ddftp=/home/dd/bin/ddftp
76	91	") ;
77	92
78		my $dump = $sshd_root->dump_tree ;
79		print $dump if $trace ;
	93	my $dump = $sshd_root->dump_tree ;
	94	print $dump if $trace ;
80	95
81		$i_sshd->write_back ;
	96	$i_sshd->write_back ;
82	97
83		my @mod = ("HostbasedAuthentication yes\n",
84		"Protocol 1,2\n",
85		"Subsystem ddftp /home/dd/bin/ddftp\n"
86		);
	98	my @mod = ("HostbasedAuthentication yes\n",
	99	"Protocol 1,2\n",
	100	"Subsystem ddftp /home/dd/bin/ddftp\n"
	101	);
87	102
88		my $aug_sshd_file = $wr_root->child('etc/ssh/sshd_config');
89		is_deeply([$aug_sshd_file->lines],\@mod,"check content of $aug_sshd_file") ;
	103	my $aug_sshd_file = $wr_root.'etc/ssh/sshd_config';
	104	open(AUG,$aug_sshd_file) \|\| die "Can't open $aug_sshd_file:$!";
	105	is_deeply([<AUG>],\@mod,"check content of $aug_sshd_file") ;
	106	close AUG;
	107
90	108
91	109	} # end SKIP section

-191

~~t/lib/LoadTest.pm~~ less more

0		# test model used by t/*.t
1
2		package LoadTest;
3		require Exporter;
4
5		our @ISA = qw/Exporter/;
6		our @EXPORT = qw/load_test_model/;
7
8		sub load_test_model {
9		my $model = shift ;
10
11		$model->create_config_class (
12		name => 'Host',
13
14		element => [
15		[qw/ipaddr canonical alias/] => {
16		type => 'leaf',
17		value_type => 'uniline',
18		}
19		]
20		);
21
22
23		$model->create_config_class (
24		name => 'Hosts',
25
26		rw_config => {
27		backend => 'augeas',
28		config_dir => '/etc/',
29		file => 'hosts',
30		set_in => 'record',
31		save => 'backup',
32		#sequential_lens => ['record'],
33		},
34
35		element => [
36		record => {
37		type => 'list',
38		cargo => {
39		type => 'node',
40		config_class_name => 'Host',
41		} ,
42		},
43		]
44		);
45
46		$model->create_config_class (
47		name => 'Sshd',
48
49		'rw_config' => {
50		backend => 'augeas',
51		config_dir => '/etc/ssh/',
52		file => 'sshd_config',
53		save => 'backup',
54		sequential_lens => [qw/HostKey Subsystem Match/],
55		},
56
57		element => [
58		'AcceptEnv', {
59		'cargo' => {
60		'value_type' => 'uniline',
61		'type' => 'leaf'
62		},
63		'type' => 'list',
64		},
65		'AllowUsers', {
66		'cargo' => {
67		'value_type' => 'uniline',
68		'type' => 'leaf'
69		},
70		'type' => 'list',
71		},
72		'ForceCommand', {
73		'value_type' => 'uniline',
74		'type' => 'leaf',
75		},
76		'HostbasedAuthentication', {
77		'value_type' => 'enum',
78		choice => [qw/no yes/],
79		'type' => 'leaf',
80		},
81		'HostKey', {
82		'cargo' => {
83		'value_type' => 'uniline',
84		'type' => 'leaf'
85		},
86		'type' => 'list',
87		},
88		'DenyUSers', {
89		'cargo' => {
90		'value_type' => 'uniline',
91		'type' => 'leaf'
92		},
93		'type' => 'list',
94		},
95		'Protocol', {
96		'default_list' => ['1', '2'],
97		'type' => 'check_list',
98		'choice' => ['1', '2']
99		},
100		'Subsystem', {
101		'cargo' => {
102		'value_type' => 'uniline',
103		'mandatory' => '1',
104		'type' => 'leaf'
105		},
106		'type' => 'hash',
107		'index_type' => 'string'
108		},
109		'Match', {
110		'cargo' => {
111		'type' => 'node',
112		'config_class_name' => 'Sshd::MatchBlock'
113		},
114		'type' => 'list',
115		},
116		'Ciphers', {
117		'upstream_default_list' => [
118		'aes256-cbc',
119		'aes256-ctr',
120		'arcfour256'
121		],
122		ordered => 1,
123		'type' => 'check_list',
124		'description' => 'Specifies the ciphers allowed for protocol version 2. By default, all ciphers are allowed.',
125		'choice' => [
126		'arcfour256',
127		'aes192-cbc',
128		'aes192-ctr',
129		'aes256-cbc',
130		'aes256-ctr'
131		]
132		},
133		]
134		);
135
136		$model->create_config_class (
137		'name' => 'Sshd::MatchBlock',
138		'element' => [
139		'Condition', {
140		'type' => 'node',
141		'config_class_name' => 'Sshd::MatchCondition'
142		},
143		'Settings',
144		{
145		'type' => 'node',
146		'config_class_name' => 'Sshd::MatchElement'
147		}
148		]
149		);
150
151		$model->create_config_class (
152		'name' => 'Sshd::MatchCondition',
153		'element' => [
154		'User', {
155		'value_type' => 'uniline',
156		'type' => 'leaf',
157		},
158		'Group', {
159		'value_type' => 'uniline',
160		'type' => 'leaf',
161		},
162		'Host', {
163		'value_type' => 'uniline',
164		'type' => 'leaf',
165		},
166		'Address', {
167		'value_type' => 'uniline',
168		'type' => 'leaf',
169		}
170		]
171		);
172
173
174		$model->create_config_class (
175		'name' => 'Sshd::MatchElement',
176		'element' => [
177		'AllowTcpForwarding', {
178		'value_type' => 'enum',
179		'type' => 'leaf',
180		'choice' => ['no', 'yes']
181		},
182		'Banner', {
183		'value_type' => 'uniline',
184		'type' => 'leaf',
185		},
186		]
187		);
188		};
189
190		1;

+26

-3

t/model_extension.t less more

6	6
7	7	# this test checks that the model extension
8	8	# (e.g. lib/Config/Model/models/Itself/Class.d/augeas-backend.pl)
9		# containing the "meta" model for Augeas backend can be loaded by
	9	# containing the "meta" model for Augeas backend can be loaded by
10	10	# Config::Model::Itself and used
11	11
12	12	# I.e.

16	16
17	17
18	18	use ExtUtils::testlib;
	19	use Log::Log4perl qw(:easy :levels) ;
19	20	use Config::Model ;
20		use Config::Model::Tester::Setup qw/init_test setup_test_dir/;
21	21	use Config::Model::Itself 2.012;
22	22
23		my ($meta_model, $trace) = init_test();
	23	no warnings qw(once);
	24
	25	my $arg = shift \|\| '';
	26	my ($log,$show) = (0) x 2 ;
	27
	28	my $trace = $arg =~ /t/ ? 1 : 0 ;
	29	$log = 1 if $arg =~ /l/;
	30	$show = 1 if $arg =~ /s/;
	31
	32	my $home = $ENV{HOME} \|\| "";
	33	my $log4perl_user_conf_file = "$home/.log4config-model";
	34
	35	if ($log and -e $log4perl_user_conf_file ) {
	36	Log::Log4perl::init($log4perl_user_conf_file);
	37	}
	38	else {
	39	Log::Log4perl->easy_init($log ? $WARN: $ERROR);
	40	}
	41
	42	Config::Model::Exception::Any->Trace(1) if $arg =~ /e/;
	43
	44	my $meta_model = Config::Model -> new ( ) ;# model_dir => '.' );
	45
	46	ok(1,"compiled");
24	47
25	48	my $meta_inst = $meta_model->instance(
26	49	root_class_name => 'Itself::Model',

+170

-139

t/test_model.pl less more

0	0	# test model used by t/*.t
1	1
2		$model->create_config_class (
	2	$model->create_config_class
	3	(
3	4	name => 'Host',
4	5
5	6	element => [
6		[qw/ipaddr canonical alias/] => { type => 'leaf', value_type => 'uniline',}
7		]
8		);
9
10		$model->create_config_class (
	7	[qw/ipaddr canonical alias/]
	8	=> { type => 'leaf',
	9	value_type => 'uniline',
	10	}
	11	]
	12	);
	13
	14
	15	$model->create_config_class
	16	(
11	17	name => 'Hosts',
12	18
13	19	rw_config => {

20	26	},
21	27
22	28	element => [
23		record => {
24		type => 'list',
25		cargo => {
26		type => 'node',
27		config_class_name => 'Host',
28		} ,
29		},
30		]
31		);
32
33		$model->create_config_class (
	29	record => { type => 'list',
	30	cargo => { type => 'node',
	31	config_class_name => 'Host',
	32	} ,
	33	},
	34	]
	35	);
	36
	37	$model->create_config_class
	38	(
34	39	name => 'Sshd',
35	40
36		rw_config => {
	41	'rw_config' => {
37	42	backend => 'augeas',
38	43	config_dir => '/etc/ssh/',
39	44	file => 'sshd_config',

42	47	},
43	48
44	49	element => [
45		'AcceptEnv' => {
46		'type' => 'list',
47		'cargo' => {
48		'value_type' => 'uniline',
49		'type' => 'leaf'
50		},
51		},
52		'AllowUsers' => {
53		'type' => 'list',
54		'cargo' => {
55		'value_type' => 'uniline',
56		'type' => 'leaf'
57		},
58		},
59		'ForceCommand' => {
60		'type' => 'leaf',
61		'value_type' => 'uniline',
62		},
63		'HostbasedAuthentication' => {
64		'type' => 'leaf',
65		'value_type' => 'enum',
66		choice => [qw/no yes/],
67		},
68		'HostKey' => {
69		'type' => 'list',
70		'cargo' => {
71		'type' => 'leaf',
72		'value_type' => 'uniline',
73		},
74		},
75		'DenyUSers' => {
76		'type' => 'list',
77		'cargo' => {
78		'type' => 'leaf',
79		'value_type' => 'uniline',
80		},
81		},
82		'Protocol' => {
83		'type' => 'check_list',
84		'default_list' => ['1', '2'],
85		'choice' => ['1', '2']
86		},
87		'Subsystem' => {
88		'type' => 'hash',
89		'index_type' => 'string',
90		'cargo' => {
91		'type' => 'leaf',
92		'value_type' => 'uniline',
93		'mandatory' => '1',
94		},
95		},
96		'Match' => {
97		'type' => 'list',
98		'cargo' => {
99		'type' => 'node',
100		'# commentnfig_class_name' => 'Sshd::MatchBlock'
101		},
102		},
103		'Ciphers' => {
104		'type' => 'check_list',
105		'upstream_default_list' => [ 'aes256-cbc', 'aes256-ctr', 'arcfour256'],
106		ordered => 1,
107		'description' => 'Specifies the ciphers allowed for protocol version 2. By default, all ciphers are allowed.',
108		'choice' => [
109		'arcfour256',
110		'aes192-cbc',
111		'aes192-ctr',
112		'aes256-cbc',
113		'aes256-ctr'
114		]
115		},
116		]
117		);
118
119		$model->create_config_class (
120		'name' => 'Sshd::MatchBlock',
121		'element' => [
122		'Condition' => {
123		'type' => 'node',
124		'config_class_name' => 'Sshd::MatchCondition'
125		},
126		'Settings' => {
127		'type' => 'node',
128		'config_class_name' => 'Sshd::MatchElement'
	50	'AcceptEnv',
	51	{
	52	'cargo' => {
	53	'value_type' => 'uniline',
	54	'type' => 'leaf'
	55	},
	56	'type' => 'list',
	57	},
	58	'AllowUsers',
	59	{
	60	'cargo' => {
	61	'value_type' => 'uniline',
	62	'type' => 'leaf'
	63	},
	64	'type' => 'list',
	65	},
	66	'ForceCommand',
	67	{
	68	'value_type' => 'uniline',
	69	'type' => 'leaf',
	70	},
	71	'HostbasedAuthentication',
	72	{
	73	'value_type' => 'enum',
	74	choice => [qw/no yes/],
	75	'type' => 'leaf',
	76	},
	77	'HostKey',
	78	{
	79	'cargo' => {
	80	'value_type' => 'uniline',
	81	'type' => 'leaf'
	82	},
	83	'type' => 'list',
	84	},
	85	'DenyUSers',
	86	{
	87	'cargo' => {
	88	'value_type' => 'uniline',
	89	'type' => 'leaf'
	90	},
	91	'type' => 'list',
	92	},
	93	'Protocol',
	94	{
	95	'default_list' => ['1', '2'],
	96	'type' => 'check_list',
	97	'choice' => ['1', '2']
	98	},
	99	'Subsystem',
	100	{
	101	'cargo' => {
	102	'value_type' => 'uniline',
	103	'mandatory' => '1',
	104	'type' => 'leaf'
	105	},
	106	'type' => 'hash',
	107	'index_type' => 'string'
	108	},
	109	'Match',
	110	{
	111	'cargo' => {
	112	'type' => 'node',
	113	'config_class_name' => 'Sshd::MatchBlock'
	114	},
	115	'type' => 'list',
	116	},
	117	'Ciphers',
	118	{
	119	'upstream_default_list' => [
	120	'aes256-cbc',
	121	'aes256-ctr',
	122	'arcfour256'
	123	],
	124	ordered => 1,
	125	'type' => 'check_list',
	126	'description' => 'Specifies the ciphers allowed for protocol version 2. By default, all ciphers are allowed.',
	127	'choice' => [
	128	'arcfour256',
	129	'aes192-cbc',
	130	'aes192-ctr',
	131	'aes256-cbc',
	132	'aes256-ctr'
	133	]
	134	},
	135	]
	136	);
	137
	138	$model->create_config_class
	139	(
	140	'name' => 'Sshd::MatchBlock',
	141	'element' => [
	142	'Condition',
	143	{
	144	'type' => 'node',
	145	'config_class_name' => 'Sshd::MatchCondition'
	146	},
	147	'Settings',
	148	{
	149	'type' => 'node',
	150	'config_class_name' => 'Sshd::MatchElement'
129	151	}
130		]
131		);
132
133		$model->create_config_class (
	152	]
	153	);
	154
	155	$model->create_config_class
	156	(
134	157	'name' => 'Sshd::MatchCondition',
135	158	'element' => [
136		'User' => {
137		'type' => 'leaf',
138		'value_type' => 'uniline',
139		},
140		'Group' => {
141		'type' => 'leaf',
142		'value_type' => 'uniline',
143		},
144		'Host' => {
145		'type' => 'leaf',
146		'value_type' => 'uniline',
147		},
148		'Address' => {
149		'type' => 'leaf',
150		'value_type' => 'uniline',
151		}
152		]
153		);
154
155		$model->create_config_class (
	159	'User',
	160	{
	161	'value_type' => 'uniline',
	162	'type' => 'leaf',
	163	},
	164	'Group',
	165	{
	166	'value_type' => 'uniline',
	167	'type' => 'leaf',
	168	},
	169	'Host',
	170	{
	171	'value_type' => 'uniline',
	172	'type' => 'leaf',
	173	},
	174	'Address',
	175	{
	176	'value_type' => 'uniline',
	177	'type' => 'leaf',
	178	}
	179	]
	180	);
	181
	182
	183	$model->create_config_class
	184	(
156	185	'name' => 'Sshd::MatchElement',
157	186	'element' => [
158		'AllowTcpForwarding' => {
159		'type' => 'leaf',
160		'value_type' => 'enum',
161		'choice' => ['no', 'yes']
162		},
163		'Banner' => {
164		'type' => 'leaf',
165		'value_type' => 'uniline',
166		},
167		]
168		);
169
170
	187	'AllowTcpForwarding',
	188	{
	189	'value_type' => 'enum',
	190	'type' => 'leaf',
	191	'choice' => ['no', 'yes']
	192	},
	193	'Banner',
	194	{
	195	'value_type' => 'uniline',
	196	'type' => 'leaf',
	197	},
	198	]
	199	);
	200
	201