Navigation

← Previous Changeset
Next Changeset →

Changeset 156

Timestamp:

06/01/04 09:56:16 (4 years ago)

Author:

svn

Message:

Added tab-completion, automatic configuration saving DIE and SIGINT handling.

Files:

manage/trunk/CLI/CLI.pm (modified) (2 diffs)
manage/trunk/manage (modified) (12 diffs)
manage/trunk/plugins/dns.pm (modified) (2 diffs)

Legend:

: Unmodified
: Added
: Removed
: Modified
: Copied
: Moved

manage/trunk/CLI/CLI.pm

r154	r156
3	3	use strict;
4	4	use warnings;
5		use vars qw($VERSION ~~@ISA @EXPORT @EXPORT_OK~~);
	5	use vars qw($VERSION);
6	6	use base qw(Exporter);
7	7
…	…
240	240	# Tokens are still remaining
241	241	if (@tokens) {
242		return ('HELP', "~~Command is complete.~~\n")
	242	return ('HELP', "\e[32m\e[1mOK Command is complete.\e[0m\n")
243	243	if "@tokens" eq '?';
244	244	return ('ERROR', 'Trailing tokens (possibly missing help?).');

manage/trunk/manage

r155	r156
1	1	#!/usr/bin/perl
2
3		~~package Manage;~~
4	2
5	3	# Add cli-parser to our module include path
…	…
21	19
22	20
23		my $BREAK = 0;
	21	my $DEBUG = 0;
	22	my $BREAK = 0; $SIG{INT} = sub { $BREAK = 1; };
	23	my $FATAL = 0; $SIG{__DIE__} = sub { $FATAL = 1; };
24	24	my @ALTCOLOURS = ("\e[36m", "\e[36m\e[1m");
25		~~$SIG{INT} = sub { $BREAK = 1; };~~
26	25	# Global variables
27	26	my $PROMPT = 'manage> ';
…	…
29	28	my $PLUGINS = './plugins';
30	29	our %CONF = (
31		~~'prompt'~~ => {
	30	prompt => {
32	31	value => \$PROMPT,
33		~~pattern => '.*',~~
34	32	help => 'CLI prompt.'
35	33	},
36		'banner' => {
37		value => \$BANNER,
38		pattern => '.*',
39		help => 'Startup banner.'
40		},
41		'plugins' => {
42		value => \$PLUGINS,
43		pattern => '.*',
44		help => 'Driver base directory.'
45		},
46
	34	debug => {
	35	value => \$DEBUG,
	36	pattern => '\d+',
	37	help => 'Set debug level (0-9).',
	38	},
47	39	);
	40	my %ORIGINAL_CONF = ();
	41	my $CLI;
48	42
49	43
50	44	# Helper functions
	45	sub logger {
	46	#print(LOG "@_");
	47	}
	48
	49	sub debug($;$) {
	50	my ($msg, $level) = @_;
	51
	52	if (defined($level)) {
	53	if ($DEBUG >= $msg) {
	54	print("\e[35m\e[1mDB$msg $level\e[0m\n");
	55	}
	56	} elsif ($DEBUG > 0) {
	57	print("\e[35m\e[1mDB1 $msg\e[0m\n");
	58	}
	59	}
	60
	61	sub fatal {
	62	my $str = "\e[31m\e[1mFTL @_\e[0m\n";
	63	print($str);
	64	logger($str);
	65	exit 1;
	66	}
	67
51	68	sub error {
52		print("\e[31m\e[1mERR @_\e[0m\n");
53		}
54
55		sub fatal {
56		error(@_);
57		exit 1;
	69	my $str = "\e[31m\e[1mERR @_\e[0m\n";
	70
	71	print($str);
	72	logger($str);
	73	return undef;
	74	}
	75
	76	sub warning {
	77	my $str = "\e[33m\e[1mWRN @_\e[0m\n";
	78
	79	print($str);
	80	logger($str);
	81	return undef;
	82	}
	83
	84	sub info {
	85	my $str;
	86
	87	if (@_ and $_[0] eq '-n') {
	88	shift(@_);
	89	$str = "\e[32m\e[1mOK\e[22m @_\e[0m";
	90	} else {
	91	$str = "\e[32m\e[1mOK\e[22m @_\e[0m\n";
	92	}
	93	print($str);
58	94	}
59	95
…	…
66	102	my $text;
67	103	my $table = new Text::Table(@header);
68		for my $r (@body) {
69		~~push(@bc, shift(@$r));~~
70		}
	104
	105	# Extract colour column
	106	for my $r (@body) { push(@bc, shift(@$r)); }
71	107
72	108	$table->load(@body);
…	…
79	115	print($bc[$line] . $text . "\e[0m\n");
80	116	}
81		#my ($width, $height) = GetTerminalSize(*STDIN);
82		#my @width = ();
83		#my $total = 0;
84		#
85		# sub sizeof($) {
86		# my $s = shift;
87		#
88		# $s =~ s/\e\[[^m]+m//g;
89		# my @s = split(/\n/m, $s);
90		# my $size = 0;
91		#
92		# for my $line (@s) {
93		# $size = length($line) if length($line) > $size;
94		# }
95		# return $size;
96		# }
97		#
98		#
99		# sub render_row($\@\@) {
100		# my $width = shift;
101		# my @row = @{$_[0]};
102		# my @width = @{$_[1]};
103		# my @out = ();
104		# my $lines = 0;
105		#
106		# for (my $i = 1; $i < @row; ++$i) {
107		# $Text::Wrap::columns = $width[$i] + 1;
108		# my @lines = split(/\n/m, wrap("", "", $row[$i]));
109		#
110		# $out[$i] = \@lines;
111		# $lines = @lines if @lines > $lines;
112		# }
113		#
114		# my $out = "";
115		# for (my $i = 0; $i < $lines; ++$i) {
116		# for (my $j = 1; $j < @row; ++$j) {
117		# my $text = $out[$j][$i];
118		#
119		# $text = "" unless defined($text);
120		# $out .= sprintf("%-$width[$j].$width[$j]s", $text);
121		# }
122		# $out .= "\n";
123		# }
124		# chomp($out);
125		# $out;
126		# }
127		#
128		# # Find minimum column sizes
129		# for (my $i = 1; $i < @header; ++$i) {
130		# $width[$i] = sizeof($header[$i]) + 1;
131		#
132		# for my $row (@body) {
133		# my $sz = sizeof($row->[$i]) + 1;
134		#
135		# $width[$i] = $sz if $sz > $width[$i];
136		# }
137		#
138		# $total += $width[$i];
139		# return if $BREAK;
140		# }
141		#
142		#my $scale = $width / $total;
143		#
144		# # Scale widths up
145		# for (my $i = 1; $i < @width; ++$i) {
146		# my $new = floor($width[$i] * $scale);
147		#
148		# if ($width[$i] < 16 and $new < $width[$i]) {
149		# } else {
150		# $width[$i] = $new;
151		# }
152		# }
153		#
154		# # Actually display the table
155		# print($header[0] . render_row($width, @header, @width) . "\e[0m\n");
156		# for my $row (@body) {
157		#
158		# last if $BREAK;
159		# print($row->[0] . render_row($width, @{$row}, @width) . "\e[0m\n");
160		# }
	117	}
	118
	119	sub exec_line {
	120	my ($type, $action, $args) = $CLI->parse("@_");
	121
	122	if ($type eq 'HELP') {
	123	print($action);
	124	} elsif ($type eq 'ACTION') {
	125	$action->(@{$args});
	126	} elsif ($type eq 'ERROR') {
	127	error($action);
	128	}
	129	}
	130
	131	sub load_config($) {
	132	my $file = shift;
	133
	134	if (open(CONF, "<$file")) {
	135	while (<CONF>) {
	136	next if /^\s$/ or /^#./;
	137	$_ =~ /^([.\w-]+)\s=\s(.*)/;
	138	if (defined($CONF{$1})) {
	139	${$CONF{$1}->{value}} = $2;
	140	}
	141	}
	142	close(CONF);
	143	}
161	144	}
162	145
…	…
173	156	'set' => {
174	157	HELP => 'Query/modify settings.',
175		'$\w+' => {
	158	'$[\w.-]+' => {
176	159	'$.+' => {
177	160	ACTION => sub {
…	…
179	162
180	163	if ($CONF{$key}) {
181		if ($value =~ /$CONF{$key}->{pattern}/) {
	164	my $pattern = $CONF{$key}->{pattern};
	165
	166	$pattern = '.+' unless defined($pattern);
	167	if ($value =~ /$pattern/) {
182	168	${$CONF{$key}->{value}} = $value;
183	169	} else {
…	…
227	213	},
228	214	},
	215	history => {
	216	clear => {
	217	ACTION => sub {
	218	Term::ReadLine::Gnu->clear_history();
	219	},
	220	HELP => "Clear the command line history."
	221	},
	222	ACTION => sub {
	223	print(join("\n", Term::ReadLine::Gnu->GetHistory) . "\n");
	224	},
	225	HELP => "Display command line history.",
	226	},
229	227	'quit\|exit' => {
230	228	HELP => [ 'exit', 'Exit.' ],
…	…
232	230	},
233	231	};
234
235		my $term = new Term::ReadLine('manage');
236		$term->ornaments(0);
	232	$CLI = new CLI(
	233	grammar => $GRAMMAR,
	234	plugins => $PLUGINS,
	235	);
	236
	237
	238	# Initialise terminal and readline
	239	my $term = new Term::ReadLine('manage'); $term->ornaments(0);
237	240	my $termattribs = $term->Attribs;
238		my $CLI = new CLI(
239		grammar => $GRAMMAR,
240		plugins => ${$CONF{plugins}->{value}},
241		);
242
243		# Turn off filename completion
244		$termattribs->{attempted_completion_function} = sub { return (''); };
	241	# Do command completion
	242	$termattribs->{completion_function} = sub {
	243	my ($text, $line, $start, $end) = @_;
	244	my ($type, $action, $args) = $CLI->parse(substr($line, 0, $start) . ' ?');
	245	my @matches;
	246
	247	if ($type eq 'HELP') {
	248	my @line = grep(/^ \e/, split(/\n/, $action));
	249
	250	for my $line (@line) {
	251	$line =~ s/^ \e\[1m([^\s\e]+).*/$1/;
	252	if ($line =~ /^$text/) {
	253	push(@matches, $line);
	254	}
	255	}
	256	}
	257	return (@matches);
	258	};
245	259	# Map the ? key to auto-magic help
246	260	$term->add_defun('dns-help', sub {
…	…
252	266	}, ord('?'));
253	267
254		sub exec_line {
255		my ($type, $action, $args) = $CLI->parse("@_");
256
257		if ($type eq 'HELP') {
258		print($action);
259		} elsif ($type eq 'ACTION') {
260		$action->(@{$args});
261		} elsif ($type eq 'ERROR') {
262		error($action);
263		}
264		}
	268	load_config("/etc/manage.conf");
	269	load_config("$ENV{HOME}/.managerc");
	270
	271	for my $key (keys %CONF) {
	272	$ORIGINAL_CONF{$key} = ${$CONF{$key}->{value}};
	273	}
	274
	275	END {
	276	Term::ReadLine::Gnu->WriteHistory("$ENV{HOME}/.managehistory");
	277	if (!$FATAL) {
	278	# Compare original config to current config
	279	for my $key (keys %CONF) {
	280	goto COMMIT if !defined($ORIGINAL_CONF{$key}) or
	281	${$CONF{$key}->{value}} ne $ORIGINAL_CONF{$key};
	282	}
	283	return;
	284	COMMIT: info("Committing modified config.");
	285	if (open(CONF, ">$ENV{HOME}/.managerc")) {
	286	foreach my $key (keys %CONF) {
	287	print(CONF "# $CONF{$key}->{help}\n");
	288	print(CONF "$key=${$CONF{$key}->{value}}\n");
	289	}
	290	close(CONF);
	291	}
	292	}
	293	}
	294
	295	Term::ReadLine::Gnu->ReadHistory("$ENV{HOME}/.managehistory");
	296
	297
	298	# The main part of the program
265	299
266	300	# Command line?
…	…
270	304	}
271	305
272		if ($BANNER) {
	306	if (@ARGV == 0 and $BANNER) {
273	307	print(<<EOF);
274	308	$BANNER
…	…
277	311
278	312	# Do the input and parsing
279		while (defined(my $line = $term->readline($PROMPT))) {
	313	my $line;
	314	while (defined($line = $term->readline($PROMPT))) {
280	315	next if $line =~ /^\s*$/;
281	316	exec_line($line);
282	317	$BREAK = 0;
283	318	}
	319
	320	print("\n") unless defined($line);

manage/trunk/plugins/dns.pm

r155	r156
1		~~package DNS;~~
2
3	1	use strict;
4	2	use warnings;
5	3
	4	my ($KEY, $SECRET, $NS) = ("", "", "");
	5	my $DETAIL = 'off';
	6	my $TIMEOUT = 'none';
	7	my $ZONE = "";
	8	my $TTL = 3600;
	9	my @RECORDS = ();
	10	my $FQDNRX = '[-a-z0-9]+(\.[-a-z0-9]+)+(\.)?';
	11	my $HOSTRX = '[-a-z0-9]+(\.[-a-z0-9]+)*(\.)?';
	12	my $IPRX = '\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}';
	13	my $STRINGRX = '\'(?:\\.\|[^\'])\'\|"(?:\\.\|[^"])"';
	14	my %UPDATE_ERRORS = (
	15	REFUSED => "Update refused.",
	16	FORMERR => "Update formatting error?",
	17	NXDOMAIN => "No such domain.",
	18	NOTAUTH => "You are not authorised to modify this zone.",
	19	NXRRSET => "Pre-requisite failed."
	20	);
	21
	22	# Export some configuration variables
	23	%::CONF = (
	24	%::CONF,
	25	'dns-detail' => {
	26	value => \$DETAIL,
	27	pattern => 'on\|off',
	28	help => 'Whether to display extra detail in zone dumps.',
	29	},
	30	'dns-key-name' => {
	31	value => \$KEY,
	32	help => 'The TSIG key name.',
	33	},
	34	'dns-key-secret' => {
	35	value => \$SECRET,
	36	help => 'The TSIG key secret.',
	37	},
	38	'dns-timeout' => {
	39	value => \$TIMEOUT,
	40	help => 'Network timeout.',
	41	},
	42	);
	43
	44	# Grammar
6	45	{
7	46	dns => {
8	47	add => sub {
9		~~print(keys(%CONF) . "\n");~~
10	48	},
11	49	delete => {
…	…
13	51	show => {
14	52	},
	53	# Initialise DNS module
	54	setup => {
	55	},
15	56	HELP => "DNS administration functions.",
16	57	},

Download in other formats: