File: fstab_test.pl

package info (click to toggle)
libconfig-model-perl 2.021-3%2Bdeb7u1
  • links: PTS, VCS
  • area: main
  • in suites: wheezy
  • size: 3,104 kB
  • sloc: perl: 20,550; makefile: 11
file content (330 lines) | stat: -rw-r--r-- 8,242 bytes parent folder | download
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
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
#
# This file is part of Config-Model
#
# This software is Copyright (c) 2012 by Dominique Dumont, Krzysztof Tyszecki.
#
# This is free software, licensed under:
#
#   The GNU Lesser General Public License, Version 2.1, February 1999
#
#    Copyright (c) 2005-2011 Dominique Dumont.
#
#    This file is part of Config-Model.
#
#    Config-Model is free software; you can redistribute it and/or
#    modify it under the terms of the GNU Lesser Public License as
#    published by the Free Software Foundation; either version 2.1 of
#    the License, or (at your option) any later version.
#
#    Config-Model is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
#    Lesser Public License for more details.
#
#    You should have received a copy of the GNU Lesser Public License
#    along with Config-Model; if not, write to the Free Software
#    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA

use strict ;
use warnings ;

# this line is necessary to run the example without installing
# Config::Model
use lib ('../../lib') ;

use Config::Model ;
use Getopt::Long ;
use Text::Wrap ;
use File::Path ;

use vars qw/$model/ ;


my $use_etc = 0;
GetOptions ("use_etc" => \$use_etc);

my $fstab_file = $use_etc ?  '/etc/fstab' : 'fstab.sample'  ;

$model = Config::Model -> new(model_dir => 'lib/Config/Model/models') ;

my $instance = $model -> instance( root_class_name => 'MyFstab',
				   instance_name => 'test',
				 ) ;

my $root= $instance -> config_root ;

print "
The first part of this example program will read a sample fstab file. You
can run this program with -use_etc to load /etc/fstab.
Just bear in mind that the Fstab model provided in this example is far from
being complete and may fail to read your file.

";

sub stop {
    print "Hit <return> to continue\n";
    my $read = <STDIN> ;
}

stop() ;

open(FSTAB, $fstab_file) || die "Can't open $fstab_file:$!";

my %opt_r_translate 
  = (
     ro => 'rw=0',
     rw => 'rw=1',
     bsddf => 'statfs_behavior=bsddf',
     minixdf => 'statfs_behavior=minixdf',
    ) ;

while (<FSTAB>) {
    s/#.*//;
    next if /^\s*$/;
    my ($device,$mount_point,$type,$options, $dump, $pass) = split;

    my ($dev_name) = ($device =~ /(\w+)$/) ;
    my $label = $type eq 'swap' ? "swap-on-$dev_name" : $mount_point; 

    my $fs_obj 
      = $root->fetch_element('fs')->fetch_with_id($label) ;

    my $load_line = "fs_vfstype=$type fs_spec=$device fs_file=$mount_point "
      ."fs_freq=$dump fs_passno=$pass" ;
    #print "loading with '$load_line'\n";
    $fs_obj->load($load_line) ;

    # now load options
    #print "fs_type $type options is $options\n";
    my @options = split /,/,$options ;
    map {
	$_ = $opt_r_translate{$_} if defined $opt_r_translate{$_};
	s/no(.*)/$1=0/ ;
	$_ .= '=1' unless /=/ ;
    } @options ;
    #print "load @options\n";
    $fs_obj->fetch_element('fs_mntopts')->load (\@options) ;
}

print "
ok. I could read $fstab_file.

The second part of this program will produce a report that shows the
settings contained in $fstab_file and shows the on-line help provided
with Fstab model (feel free to modify the model (Fstab.pm) to provide
more help).

";

stop ;

print $root->report() ;

print "

The third part of this program will produce a minimal fstab file
without any comment:

";

stop ;
# now write back a valid fstab file

sub produce_fstab {
    my $with_help = shift || 0 ;

    my %opt_w_translate = 
      (
       rw              => { 0 => 'ro', 1 => 'rw' },
       statfs_behavior => { bsddf => 'bsddf', minixdf => 'minixdf'},
       user            => { 0 => '' , 1 => 'user'},
       user_xattr      => { 0 => '' , 1 => 'user_xattr'},
       sw              => { 0 => '' , 1 => 'sw'},
       defaults        => { 0 => '' , 1 => 'defaults'},
       auto            => { 0 => 'noauto' , 1 => 'auto'},
      );

    my @new_fstab ;
    foreach my $fs_obj ($root->fetch_element('fs')->fetch_all) {
	my $opt_container = $fs_obj->fetch_element('fs_mntopts');
	my $fs_type = $fs_obj->fetch_element_value('fs_vfstype');

	if ($with_help) {
	    my $fs_help = $fs_obj->fetch_element('fs_vfstype')
	      ->get_help($fs_type);
	    push @new_fstab, 
	      "# fs label: ".$fs_obj->index_value ,
	      wrap("# '$fs_type' file system: ",
		   '#    ', $fs_help) if $fs_help;
	}

	my @opt_arg;
	foreach my $opt_name ($opt_container -> get_element_name) {
	    my $opt_value = $opt_container->fetch_element_value($opt_name) ;
	    next unless defined $opt_value;

	    my $show_value = '';;
	    if (defined $opt_w_translate{$opt_name} &&
		defined $opt_w_translate{$opt_name}{$opt_value} ) {
		$show_value = $opt_w_translate{$opt_name}{$opt_value} ;
	    }
	    elsif (defined $opt_w_translate{$opt_name}) {
		$show_value = $opt_value ;
	    }
	    else {
		$show_value = "$opt_name=$opt_value" ;
	    }

	    if ($with_help) {
		my $opt_help = $opt_container->fetch_element($opt_name)
		  -> get_help($opt_value) ;
		push @new_fstab, wrap("#    * option '$show_value' effect: ",
				      '#        ', $opt_help) if $opt_help;
	    }

	    push @opt_arg, $show_value if $show_value ;
	}

	push @new_fstab, sprintf("%-10s %-20s %-15s %-15s %d %d",
				 $fs_obj->fetch_element_value('fs_spec'),
				 $fs_obj->fetch_element_value('fs_file'),
				 $fs_type ,
				 join(',',@opt_arg),
				 $fs_obj->fetch_element_value('fs_freq'),
				 $fs_obj->fetch_element_value('fs_passno'),
				) ;
	push @new_fstab, "" if $with_help ;
    }

    return @new_fstab
}


print join ("\n",produce_fstab()),"\n";

print "

To help newbie admin to understand their configuration files, this
program can also produce a fstab file with the help and descriptions
provided in fstab model.

";

stop ;

print join ("\n",produce_fstab(1)),"\n";

print "

Now you can enter in an interactive shell to explore or modify the
fstab data (do not fear to play in the pseudo-shell provided by this
program as the modified data will not be written back to /etc/fstab).

Exit the pseudo-shell by typing CTRL-D. 

The first command you might want to type is 'help'. You can also hit
TAB twice to get the list of available commands.

" ;

stop ;

my $store = sub { 
    my $dir = shift ;
    mkpath ($dir,0, 0755) unless -d $dir ;
    open(FILE,"> $dir/fstab") || die "Cannot open $dir/fstab: $!";
    print FILE join ("\n",produce_fstab()),"\n";
    close FILE ;
    return "Written $dir/fstab";
};

require Config::Model::TermUI;
my $term_ui = Config::Model::TermUI
  -> new( root => $root ,
	  title => $fstab_file.' configuration',
	  prompt => ' >',
	  store_sub => $store,
	);

# engage in user interaction
$term_ui -> run_loop ;

eval {require Config::Model::TkUI} ;

if ($@) {
    print "

If you want to try the Perl/Tk graphical interface, you must install 
Config::Model::TkUI and re-run this test.

" ;
}
else {
    print "

Now you can enter in a Tk graphical interface to check fstab
data. Like before, data are not written back to /etc/fstab, so feel
free to experiment

" ;

    stop ;

    use Log::Log4perl qw(:easy) ;
    Log::Log4perl->easy_init($WARN);

    require Tk;
    require Tk::ErrorDialog;
    Tk->import ;

    my $mw = MainWindow-> new ;
    $mw->withdraw ;

    $mw->ConfigModelUI (-root => $root,) ;

    &MainLoop ; # Tk's
}

eval {require Config::Model::CursesUI} ;

if ($@) {
    print "

If you want to try the curses interface, you must install 
Config::Model::CursesUI and re-run this test.

" ;
}
else {
    my $err_file = '/tmp/config-model-error.log' ;

    print "

Now you can enter in a curses interface to check fstab data. Like
before, data are not written back to /etc/fstab, so feel free to
experiment

In case of error, check $err_file

" ;

    stop ;

    open (FH,"> $err_file") || die "Can't open $err_file: $!" ;
    open STDERR, ">&FH";

    my $dialog = Config::Model::CursesUI-> new
      (
       permission => 'advanced',
      ) ;

    # engage in user interaction
    # eval is required to trap the exit done in Curses
    eval{ $dialog->start( $model ) } ;

    close FH ;
}


print "\n$0 done. Feel free to send feedback to the author ",
  "(ddumont at cpan dot org)\n\n";