#!/usr/bin/perl -w

# $Id: clamdsh.pl,v 1.24 2007/08/17 23:49:49 okamura Exp $

require 5.8.0;
use strict;
use utf8;
#===============================================================================
package ClamAV::Shell::Config;
#===============================================================================
#---------------------------------------
# モジュール
#---------------------------------------
# システム
use Carp;
use Storable	qw(nstore retrieve);
use Cwd;

# プロジェクト

#---------------------------------------
# グローバル変数宣言
#---------------------------------------
use vars qw(
	$SystemWideConfFile
	%Default
);

#---------------------------------------
# 定数
#---------------------------------------
$SystemWideConfFile = '/etc/clamdsh.conf';

%Default = (
	'config'	=> {
		'path'	=> sprintf('%s/.clamdsh.conf', (getpwuid( $> ))[7]),
		'perm'	=> 0600,
		'owner'	=> (getpwuid( $> ))[2],
		'group'	=> (getpwuid( $> ))[3],
	},
	'terminal'	=> {
		'name'	=> 'Clamd Shell',
		'input'	=> \*STDIN,
		'ouput'	=> \*STDOUT,
	},
	'option'	=> {
		'LocalSocket'		=> undef,
		'TCPSocket'			=> undef,
		'TCPAddr'			=> undef,
		'StreamMaxLength'	=> 10*1024*1024,
		'prompt'			=> '\{clamd}\$ ',
		'timeout'			=> 10,
		'bufsiz'			=> 4096,
		'histfile'	=> sprintf('%s/.clamdsh.history', (getpwuid( $> ))[7]),
		'histsize'	=> 500,
	},
	'optionHandler'	=> undef,
	'status'	=> {
		'PWD'	=> getcwd,
		'HOME'	=> (getpwuid( $> ))[7],
	},
	'variable'	=> {
	},
);
if (-f $SystemWideConfFile) {
	if (open SYSCONFIG, $SystemWideConfFile) {
		my	%default;

		%default = eval join '', <SYSCONFIG>;
		if ($@) {
			print STDERR $@;
		}
		else {
			%Default = %default;
		}
		close SYSCONFIG;
	}
	else {
		printf STDERR "%s\n", "$!";
	}
}

#---------------------------------------
# 関数
#---------------------------------------
sub InterpretStringValue {
	return $_[0];
}

sub InterpretNumberValue {
	unless ($_[0] =~ m/^\d+$/) {
		return undef;
	}
	return $_[0] + 0;
}

sub InterpretSizeValue {
	return undef	unless ($_[0] =~ m/^\d+/i);
	my	($num, $unit) = ($&, $');

	if (!defined($unit) or $unit eq '') {
		$unit = 1;
	}
	elsif ($unit eq 'k' or $unit eq 'K') {
		$unit = 1024;
	}
	elsif ($unit eq 'm' or $unit eq 'M') {
		$unit = 1024 * 1024;
	}
	else {
		return undef;
	}

	return $num * $unit;
}

#---------------------------------------
# メソッド
#---------------------------------------
sub new {
	my	$class = shift;
	my	$this = {%Default, @_};

	bless $this;
	$this->loadClamdConf();

	return $this;
}

sub loadClamdConf {
	my	$this = shift;
	my	($confFile) = @_;

	unless (defined $confFile) {
		my	$openRet;

		$openRet = eval {
			local	%SIG;
			
			$SIG{__WARN__} = sub { 1; };
			open SHELL, '-|', 'clamav-config', '--prefix';
		}; 
		if ($openRet) {
			$_ = <SHELL>;
			close SHELL;
			chomp $_;
			$confFile = $_;
		}
		else {
			$confFile = '/usr/local';
		}
		$confFile = File::Spec->catfile($confFile, 'etc', 'clamd.conf');
	}

	unless (-f $confFile) {
		return undef;
	}
	unless (open CONF, $confFile) {
		return 0;
	}
	$this->readClamdConfig(\*CONF);
	close CONF;

	return 1;
}

sub readClamdConfig {
	my	$this = shift;
	my	($fh) = @_;

	while (my $line = <$fh>) {
		next	if ($line =~ m/^\s*#/);
		next	if ($line =~ m/^s*$/);
		chomp $line;
		next	unless ($line =~ m/^\s*(\w+)\s+(.*)$/);
		my	($option, $value) = ($1, $2);

		$value =~ s/\s*$//;
		if ($option eq 'LocalSocket') {
			$value = InterpretStringValue($value);
			if (defined $value) {
				$this->set($option, $value);
			}
		}
		elsif ($option eq 'TCPSocket') {
			$value = InterpretNumberValue($value);
			if (defined $value) {
				$this->set($option, $value);
			}
		}
		elsif ($option eq 'TCPAddr') {
			$value = InterpretStringValue($value);
			if (defined $value) {
				$this->set($option, $value);
			}
		}
		elsif ($option eq 'StreamMaxLength') {
			$value = InterpretSizeValue($value);
			if (defined $value) {
				$this->set($option, $value);
			}
		}
	}
}

sub load {
	my	$this = shift;
	my	$path = shift;
	my	$personal;

	$path = $this->{'config'}->{'path'}	unless (defined $path);

	eval {
		$personal = retrieve($path);
	};
	if (defined $personal) {
		foreach my $key (keys %{$this->{'option'}}) {
			next	unless (exists $personal->{'option'}->{$key});
			$this->set($key, $personal->{'option'}->{$key});
		}
		$this->{'variable'} = $personal->{'variable'};
	}

	return $personal;
}

sub save {
	my	$this = shift;
	my	$path = shift;
	my	$personal;
	my	$retVal = undef;

	$path = $this->{'config'}->{'path'}	unless (defined $path);

	$personal = {
		'option'	=> $this->{'option'},
		'variable'	=> $this->{'variable'},
	};

	$retVal = nstore($personal, $path);
	if ($retVal) {
		chmod $this->{'config'}->{'perm'}, $path;
		chown $this->{'config'}->{'owner'}, $this->{'config'}->{'group'}, $path;
	}

	return $retVal;
}

sub set {
	my	$this = shift;
	my	($name, $value) = @_;

	if (exists $this->{'option'}->{$name}) {
		my	$oldValue = $this->{'option'}->{$name};

		$this->{'option'}->{$name} = $value;
		if (defined $this->{'optionHandler'}) {
			&{$this->{'optionHandler'}}($name, $value, $oldValue);
		}
	}
	elsif (exists $this->{'status'}->{$name}) {
		return 0;
	}
	else {
		$this->{'variable'}->{$name} = $value;
	}

	return 1;
}

sub unset {
	my	$this = shift;
	my	($name) = @_;
	my	$retVal = 0;

	if (exists $this->{'option'}->{$name}) {
		my	$oldValue = $this->{'option'}->{$name};

		$this->{'option'}->{$name} = undef;
		if (defined $this->{'optionHandler'}) {
			&{$this->{'optionHandler'}}($name, undef, $oldValue);
		}
		$retVal = 1;
	}
	elsif (exists $this->{'variable'}->{$name}) {
		delete $this->{'variable'}->{$name};
		$retVal = 1;
	}

	return $retVal;
}

sub get {
	my	$this = shift;
	my	($name) = @_;

	if (exists $this->{'option'}->{$name}) {
		unless (defined $this->{'option'}->{$name}) {
			return $Default{'option'}->{$name};
		}
		return $this->{'option'}->{$name};
	}

	if (exists $this->{'status'}->{$name}) {
		return $this->{'status'}->{$name};
	}

	if ($this->{'variable'}->{$name}) {
		return $this->{'variable'}->{$name};
	}

	return undef;
}

#---------------------------------------
# グローバル変数初期値
#---------------------------------------

#===============================================================================
package ClamAV::Shell::Terminal;
#===============================================================================
#---------------------------------------
# モジュール
#---------------------------------------
# システム
use Term::ReadLine;
use POSIX	qw(strftime);
use Sys::Hostname;
use Cwd;
use File::Basename;

# プロジェクト

#---------------------------------------
# グローバル変数宣言
#---------------------------------------
use vars	qw(
	%PromptVar
);

#---------------------------------------
# 定数
#---------------------------------------
%PromptVar = (
	# bell
	qr/\\b/	=> sub { "\07" },
	# "Weekday Month Date"
	qr/\\d/	=> sub { POSIX::strftime('%a %b %d', localtime) },
	# strftime
	qr/\\D\{([^}]*)\}/	=> sub { strftime($1, localtime) },
	# escape
	qr/\\e/	=> sub { "\033" },
	# short hostname
	qr/\\h/	=> sub {
		my	$name = hostname();
		$name =~ s/\..*//;
		$name
	},
	# hostname
	qr/\\H/	=> sub { hostname() },
	# newline
	qr/\\n/	=> sub { "\n" },
	# carriage return
	qr/\\r/	=> sub { "\r" },
	# 24-hour HH:MM:SS
	qr/\\t/	=> sub { strftime('%T', localtime) },
	# 12-hour HH:MM:SS
	qr/\\T/	=> sub { strftime('%I:%M:%S', localtime) },
	# 12-hour am/pm
	qr/\\@/	=> sub { strftime('%r', localtime) },
	# 24-hour HH:MM
	qr/\\A/	=> sub { strftime('%R', localtime) },
	# current user name
	qr/\\u/	=> sub { getpwuid($> ) },
	# the version of clamdsh.pl
	qr/\\v/	=> sub {
		my	$v = $main::Version;
		if ($v =~ m/clamdsh\.pl v(\d+\.\d+)/) {
			$v = "$1";
		}
		elsif ($v =~ m/clamdsh\.pl v(\d+)/) {
			$v = "$1.0";
		}
		$v
	},
	# the version + patchelvel of clamdsh.pl
	qr/\\V/	=> sub {
		my	$v = $main::Version;
		if ($v =~ m/clamdsh\.pl v(\d+\.\d+(?:\.\d+)+)/) {
			$v = $1;
		}
		elsif ($v =~ m/clamdsh\.pl v(\d+\.\d+)/) {
			$v = "$1.0";
		}
		elsif ($v =~ m/clamdsh\.pl v(\d+)/) {
			$v = "$1.0.0";
		}
		$v
	},
	# current working directory
	qr/\\w/	=> sub { cwd() },
	# basename of current working directory
	qr/\\W/	=> sub { basename(Cwd::cwd()) },
	# history number
	qr/\\!/	=> sub { $_[0]->{'linenum'} },
	# command number (synonym of history number)
	qr/\\\*/	=> sub { $_[0]->{'linenum'} },
	# # or $
	qr/\\\$/	=> sub { ${>} ? '$' : '#' },
	# charctor octal code
	qr/\\([0-7]{3})/	=> sub { chr(oct($0)) },
	# backslash
	qr/\\\\/	=> sub { '\\' },

	# LocalSocket
	qr/\\\{LocalSocket\}/	=> sub {
		$_[0]->config()->get('LocalSocket')
			? $_[0]->config()->get('LocalSocket')
			: ''
	},
	# TCPAddr
	qr/\\\{TCPAddr\}/	=> sub {
		$_[0]->config()->get('TCPAddr')
			? $_[0]->config()->get('TCPAddr')
			: ''
	},
	# TCPSocket
	qr/\\\{TCPSocket\}/	=> sub {
		$_[0]->config()->get('TCPSocket')
			? $_[0]->config()->get('TCPSocket')
			: ''
	},
	# StreamMaxLength
	qr/\\\{StreamMaxLength\}/	=> sub {
		$_[0]->config()->get('StreamMaxLength')
			? $_[0]->config()->get('StreamMaxLength')
			: ''
	},
	# timeout
	qr/\\\{timeout\}/	=> sub {
		$_[0]->config()->get('timeout')
			? $_[0]->config()->get('timeout')
			: ''
	},
	# bufsiz
	qr/\\\{bufsiz\}/	=> sub {
		$_[0]->config()->get('bufsiz')
			? $_[0]->config()->get('bufsiz')
			: ''
	},
	# clamd socket
	qr/\\\{clamd\}/	=> sub {
		if (defined($_[0]->config()->get('LocalSocket'))) {
			$_[0]->config()->get('LocalSocket')
		}
		elsif (
			defined($_[0]->config()->get('TCPSocket'))
		) {
			sprintf("%s:%s",
				$_[0]->config()->get('TCPAddr')
					? $_[0]->config()->get('TCPAddr')
					: '127.0.0.1'
				,
				$_[0]->config()->get('TCPSocket')
			)
		}
		else {
			'(no clamd)'
		}
	},
);

#---------------------------------------
# メソッド
#---------------------------------------
sub new {
	my	$class = shift;
	my	$this = {
		'config'	=> undef,
		'term'		=> undef,
		'closed'	=> 0,
		'histfile'	=> [],
		'linenum'	=> 0,
	};

	bless $this;
	if (0 < scalar(@_) and defined $_[0]) {
		$this->{'config'} = $_[0];
	}
	else {
		$this->{'config'} = ClamAV::Shell::Config->new()
	}
	$this->{'term'} = Term::ReadLine->new(
		$this->config()->{'terminal'}->{'name'},
		$this->config()->{'terminal'}->{'input'},
		$this->config()->{'terminal'}->{'output'},
	);

	$this->{'term'}->Features()->{'autohistory'} = 0;
	$this->load($this->config()->get('histfile'));

	return $this;
}

sub load {
	my	$this = shift;
	my	$path = shift;
	my	$num = shift;
	my	$readNum = undef;

	$path = $this->config()->get('histfile')	unless (defined $path);
	$num = $this->config()->get('histsize')	unless (defined $num);

	$this->{'term'}->MinLine($num);
	if (open HISTORY, $path) {
		my	@line = <HISTORY>;

		close HISTORY;
		$this->addhistory(@line);
	}

	return $readNum;
}

sub addhistory {
	my	$this = shift;
	my	@line = @_;

	for (my $i = 0; $i < scalar(@line); $i++) {
		chomp $line[$i];
		$this->{'term'}->addhistory($line[$i]);
		$this->{'linenum'}++;
	}
	push @{$this->{'history'}}, @line;

	if ($this->config()->get('histsize') < scalar(@{$this->{'history'}})) {
		my	@history = @{$this->{'history'}};

		@{$this->{'history'}} = @history[
			scalar(@history) - $this->config()->get('histsize')
			..
			$#history
		];
	}
}

sub save {
	my	$this = shift;
	my	$path = shift;
	my	$num = shift;
	my	$writeNum = undef;

	$path = $this->config()->get('histfile')	unless (defined $path);
	$num = $this->config()->get('histsize')	unless (defined $num);

	if (defined($path) and defined($num) and 0 < $num) {
		if (open HISTORY, ">$path") {
			for ($writeNum = 0;
				$writeNum < scalar(@{$this->{'history'}});
				$writeNum++
			) {
				printf HISTORY "%s\n", $this->{'history'}->[$writeNum];
			}
			close HISTORY;
			chmod $this->config()->{'config'}->{'perm'}, $path;
			chown $this->config()->{'config'}->{'owner'},
				$this->config()->{'config'}->{'group'},
				$path
			;
		}
	}

	return $writeNum;
}

sub readline {
	my	$this = shift;
	my	$prompt = shift;
	my	$line = undef;

	return undef	if ($this->{'closed'});

	$prompt = $this->config()->get('prompt')	unless (defined $prompt);
	while (my ($reg, $func) = each %PromptVar) {
		$prompt =~ s/$reg/&{$func}($this)/eg;
	}

	while ($line = $this->{'term'}->readline($prompt)) {
		$line =~ s/^\s*//;
		$line =~ s/\s*$//;
		last	if ($line ne '');
	}

	if (defined($line) and $line ne '') {
		$this->addhistory($line);
	}
	return $line;
}

sub expandPrompt {
	my	$this = shift;
	my	$prompt = shift;
}

sub print {
	my	$this = shift;
	my	$fh = $this->{'term'}->OUT;

	if ($this->{'term'}->OUT) {
		print {$this->{'term'}->OUT} @_;
	}
	else {
		print STOUT @_;
	}
}

sub printf {
	my	$this = shift;
	my	$fh = $this->{'term'}->OUT;

	if ($this->{'term'}->OUT) {
		printf {$this->{'term'}->OUT} @_;
	}
	else {
		printf STOUT @_;
	}
}

sub error {
	my	$this = shift;

	print STDERR @_;
}

sub errorf {
	my	$this = shift;

	printf STDERR @_;
}

sub config {
	my	$this = shift;

	return $this->{'config'};
}

#---------------------------------------
# グローバル変数初期値
#---------------------------------------

#===============================================================================
package ClamAV::Shell::Command;
#===============================================================================
#---------------------------------------
# モジュール
#---------------------------------------
# システム
use Pod::Usage;

# プロジェクト

#---------------------------------------
# グローバル変数宣言
#---------------------------------------
use vars qw(
	%Command
);

#---------------------------------------
# 定数
#---------------------------------------

#---------------------------------------
# メソッド
#---------------------------------------
sub new {
	my	$class = shift;
	my	$this = {
		'name'	=> undef,
		'func'	=> undef,
		'pod'	=> undef,
		@_
	};

	unless (
		defined($this->{'name'})
			and
		defined($this->{'func'})
			and
		defined($this->{'pod'})
	) {
		return undef;
	}
	bless $this;

	return $this;
}

sub regist {
	my	$this = shift;
	my	$retVal = undef;

	if (!$this->isregist()) {
		foreach my $name (@{$this->{'name'}}) {
			$Command{$name} = $this;
		}
		$retVal = 1;
	}

	return $retVal;
}

sub unregist {
	my	$this = shift;
	my	$retVal = undef;

	if ($this->isregist()) {
		foreach my $name (@{$this->{'name'}}) {
			delete $Command{$name};
		}
		$retVal = 1;
	}

	return $retVal;
}

sub isregist {
	my	$this = shift;

	return exists $Command{${$this->{'name'}}[0]};
}

sub do {
	my	$this = shift;
	my	$shell = shift;
	our	@ARGV = @_;

	eval {
		&{$this->{'func'}}($shell, @ARGV);
	};
	if ($@) {
		$shell->{'terminal'}->error($@);
	}
}

sub usage {
	my	$this = shift;
	my	$shell = shift;
	my	%option = @_;
	my	$term = $shell->terminal();

	open POD, '<', \$this->{'pod'};
	pod2usage(
		-exitval	=> 'NOEXIT',
		-input		=> \*POD,
		-output		=> $term->{'term'}->OUT
			? $term->{'term'}->OUT
			: \*STDOUT
		,
		%option,
	);
	close POD;
}

#---------------------------------------
# グローバル変数初期値
#---------------------------------------
%Command = (
);

#===============================================================================
package ClamAV::Shell::Command::Basic;
#===============================================================================
#---------------------------------------
# モジュール
#---------------------------------------
# システム
use Getopt::Long	qw(GetOptionsFromArray);
use Cwd;

# プロジェクト

#---------------------------------------
# グローバル変数宣言
#---------------------------------------
use vars qw(
	@ISA
);

#---------------------------------------
# 定数
#---------------------------------------
@ISA = qw(ClamAV::Shell::Command);

#---------------------------------------
# サブルーチン
#---------------------------------------

#---------------------------------------
# グローバル変数初期値
#---------------------------------------
ClamAV::Shell::Command->new(
	'name'	=> [qw(exit quit)],
	'func'	=> sub {
		my	$shell = shift;
		my	$term = $shell->terminal();

		$term->{'closed'} = 1;
	},
	'pod'	=> "=head1 NAME

exit - terminate.
\n=head1 SYNOPSIS

exit

quit
\n=head1 DESCRIPTION

B<exit> terminate the command line loop.",
)->regist();

ClamAV::Shell::Command->new(
	'name'	=> [qw(load)],
	'func'	=> sub {
		my	$shell = shift;
		my	$config = $shell->config();

		$config->load($_[1]);
	},
	'pod'	=> "=head1 NAME

load - load personal configuration.
\n=head1 SYNOPSIS

load [I<file>]
\n=head1 DESCRIPTION

B<load> loads personal configurations from I<file>.
If I<file> is ommited, use F<~/.clamdsh.conf>.
Administrator of your system maybe change the default personal configuration
file path.",
)->regist();

ClamAV::Shell::Command->new(
	'name'	=> [qw(save)],
	'func'	=> sub {
		my	$shell = shift;
		my	$config = $shell->config();

		$config->save($_[1]);
	},
	'pod'	=> "=head1 NAME

save - save personal configuration.
\n=head1 SYNOPSIS

save [I<file>]
\n=head1 DESCRIPTION

B<save> saves a personal configuration from I<file>.
If I<file> is ommited, use F<~/.clamdsh.conf>..
Administrator of your system maybe change the default personal configuration
file path.",
)->regist();

ClamAV::Shell::Command->new(
	'name'	=> [qw(echo)],
	'func'	=> sub {
		my	$shell = shift;
		my	$term = $shell->terminal();

		$term->print("@_\n");
	},
	'pod'	=> "=head1 NAME

echo - echo back arguments.
\n=head1 SYNOPSIS

echo ...
\n=head1 DESCRIPTION

B<echo> echos back arguments.",
)->regist();

ClamAV::Shell::Command->new(
	'name'	=> [qw(set)],
	'func'	=> sub {
		my	$shell = shift;
		my	($name, $value) = @_;
		my	$term = $shell->terminal();
		my	$config = $shell->config();

		if (defined($name) and defined($value)) {
			unless ($config->set($name, $value)) {
				$term->errorf("set: Don't set %s\n", $name);
			}
		}
		elsif (!defined($name) and !defined($value)) {
			foreach my $name (
				sort
					keys(%{$config->{'option'}}),
					keys(%{$config->{'variables'}}),
					keys(%{$config->{'status'}})
			) {
				my	$value = $config->get($name);

				$value = '(undef)'	unless (defined $value);
				$term->printf("%s=%s\n", $name, $value);
			}
		}
		else {
			$ClamAV::Shell::Command::Command{'set'}->usage(
				$shell,
				-verbose => 0
			);
		}
	},
	'pod'	=> "=head1 NAME

set - set and list variable.
\n=head1 SYNOPSIS

set [I<name> I<value>]
\n=head1 DESCRIPTION

B<set> specifies an variable I<name> with a value of I<value>.
If no arguments are given, B<set> prints out the names and values of variables.
\n=head1 VARIABLES
\n=head2 CLAMD OPTIONS

For detail, see L<clamd.conf(5)|clamd.conf>.
\n=over 4
\n=item LocalSocket
\n=item StreamMaxLength
\n=item TCPAddr
\n=item TCPSocket
\n=back
\n=head2 CLAMDSH OPTIONS

For detail, see L<OPTIONS section in clamdsh.pl(1)|clamdsh.pl/OPTIONS>.
\n=over 4
\n=item bufsiz
\n=item histfile
\n=item histsize
\n=item prompt
\n=item timeout
\n=back
\n=head2 STATUS VARIABLES

These variables are read only.
\n=over 4
\n=item HOME

Your home directory.
\n=item PWD

Current working directory.
\n=back
\n=head1 SEE ALSO

L<clamd.conf(5)|clamd.conf>,
L<OPTIONS section in clamdsh.pl(1)|clamdsh.pl/OPTIONS>",
)->regist();

ClamAV::Shell::Command->new(
	'name'	=> [qw(unset)],
	'func'	=> sub {
		my	$shell = shift;
		my	($name) = @_;
		my	$term = $shell->terminal();
		my	$config = $shell->config();

		if (defined($name)) {
			my	$ret = $config->unset($name);

			unless ($ret) {
				if ($config->get($name)) {
					$term->errorf("unset: Don't uneset %s\n", $name);
				}
				else {
					$term->errorf("unset: %s isn't defined.\n", $name);
				}
			}
		}
		else {
			$ClamAV::Shell::Command::Command{'unset'}->usage(
				$shell,
				-verbose => 0
			);
		}
	},
	'pod'	=> "=head1 NAME

unset - unset variable.
\n=head1 SYNOPSIS

unset I<name>
\n=head1 DESCRIPTION

B<unset> deletes definition of variable I<name>.",
)->regist();

ClamAV::Shell::Command->new(
	'name'	=> [qw(help ?)],
	'func'	=> sub {
		my	$shell = shift;
		my	($cmd) = @_;
		my	$term = $shell->terminal();
		my	$config = $shell->config();

		if (defined $cmd) {
			if (exists $ClamAV::Shell::Command::Command{$cmd}) {
				$ClamAV::Shell::Command::Command{$cmd}->usage(
					$shell, -verbose => 2
				);
			}
			else {
				$term->errorf("help: command \"%s\" is not defined.\n", $cmd);
			}
		}
		else {
			my	$list = '';

			foreach my $cmd (sort keys %ClamAV::Shell::Command::Command) {
				my	$podName = '';

				open PODNAME, '>', \$podName;
				$ClamAV::Shell::Command::Command{$cmd}->usage(
					$shell,
					-verbose	=> 99,
					-sections	=> 'NAME',
					-output		=> \*PODNAME,
				);
				close PODNAME;
				chomp $podName;
				$podName =~ s/^Name:\s*//s;
				$podName =~ s/\s*$/\n/s;
				$podName =~ s/^\S+ - /$cmd - /;
				$list .= $podName;
			}
			$term->print($list);
		}
	},
	'pod'	=> "=head1 NAME

help - print help.
\n=head1 SYNOPSIS

help [I<command>]

? [I<command>]
\n=head1 DESCRIPTION

B<help> print out command list.
If I<command> is given, B<help> print out help of I<command>.",
)->regist();

ClamAV::Shell::Command->new(
	'name'	=> [qw(history)],
	'func'	=> sub {
		my	$shell = shift;
		my	$term = $shell->terminal();
		my	%option = (
			'clear'		=> 0,
			'delete'	=> undef,
		);

		if (
			GetOptionsFromArray(
				\@_,
				'c|clear'		=> \$option{'clear'},
				'd|delete=i'	=> \$option{'delete'},
				'r|read=s'		=> \$option{'read'},
				'w|write=s'		=> \$option{'write'},
			)
		) {
			if (1 < scalar(keys %option)) {
				$ClamAV::Shell::Command::Command{'history'}->usage(
					$shell,
					-verbose => 0
				);
			}
			elsif ($option{'clear'}) {
				$term->{'history'} = [];
			}
			elsif ($option{'delete'}) {
				if ($option{'delete'} == 0) {
					@{$term->{'history'}} = @{$term->{'history'}}[
						1
						..
						$#{$term->{'history'}}
					];
				}
				elsif ($option{'delete'} == $#{$term->{'history'}}) {
					pop @{$term->{'history'}};
				}
				elsif (
					0 < $option{'delete'}
						and
					$option{'delete'} < $#{$term->{'history'}}
				) {
					@{$term->{'history'}} = (
						@{$term->{'history'}}[
							0
							..
							$option{'delete'} - 1
						],
						@{$term->{'history'}}[
							$option{'delete'} + 1
							..
							$#{$term->{'history'}}
						],
					);
				}
			}
			elsif ($option{'read'}) {
				$term->load($option{'read'});
			}
			elsif ($option{'write'}) {
				$term->save($option{'read'});
			}
			else {
				my	($num) = @_;

				$num = scalar(@{$term->{'history'}})	unless (defined $num);
				for (
					my $i = scalar(@{$term->{'history'}}) - $num;
					$i < scalar(@{$term->{'history'}});
					$i++
				) {
					$term->printf("%d: %s\n",
						$term->{'linenum'} - scalar(@{$term->{'history'}}) + $i,
						$term->{'history'}->[$i]
					);
				}
			}
		}
		else {
			$ClamAV::Shell::Command::Command{'history'}->usage(
				$shell,
				-verbose => 0
			);
		}
	},
	'pod'	=> "=head1 NAME

history - print or maintain history.
\n=head1 SYNOPSIS

history [I<num>]

history -c|--clear

history -d|--delete I<offset>

history -r|--read I<file>

history -w|--write I<file>
\n=head1 DESCRIPTION

B<history> with no options prints command-line history with line number.
An argument of I<num> lists only last I<num> lines.
\n=head1 OPTIONS
\n=over 4
\n=item -c|--clear

Clear the history list.
\n=item -d|--delete I<offset>

Delete the history entry at position I<offset>.
\n=item -r|--read I<file>

Read the contents of the history file I<file>.
\n=item -w|--write I<file>

Write the current history to the history file I<file>.
\n=back",
)->regist();

ClamAV::Shell::Command->new(
	'name'	=> [qw(cd chdir)],
	'func'	=> sub {
		my	$shell = shift;
		my	($dir) = @_;
		my	$config = $shell->config();
		my	$term = $shell->terminal();

		$dir = (getpwuid( $> ))[7]	unless (defined $dir);
		if (chdir $dir) {
			$config->{'status'}->{'PWD'} = getcwd;
		}
		else {
			$term->errorf("cd: %s\n", "$!");
		}
	},
	'pod'	=> "=head1 NAME

cd - change current directory.
\n=head1 SYNOPSIS

cd [I<dir>]

chdir [I<dir>]
\n=head1 DESCRIPTION

B<cd> changes current directory to I<dir>.
If I<dir> is not given, B<cd> changes current directory to home directory.",
)->regist();

ClamAV::Shell::Command->new(
	'name'	=> [qw(system)],
	'func'	=> sub {
		my	$shell = shift;
		my	(@cmd) = @_;

		if (0 < scalar(@cmd)) {
			local	%SIG;
			my	$term = $shell->terminal();

			$SIG{__WARN__} = sub { 1; };
			if (system @cmd) {
				if ($? == -1) {
					$term->errorf("system: failed to execute: %s\n", "$!");
				}
				elsif ($? & 127) {
					$term->errorf(
						"system: child died with signal %d, %s coredump\n",
						($? & 127),  ($? & 128) ? 'with' : 'without'
					);
				}
				else {
					$term->errorf(
						"system: child exited with value %d\n", $? >> 8
					);
				}
			}
		}
		else {
			$ClamAV::Shell::Command::Command{'system'}->usage(
				$shell,
				-verbose => 0
			);
		}
	},
	'pod'	=> "=head1 NAME

system - execute system command.
\n=head1 SYNOPSIS

system ...
\n=head1 DESCRIPTION

B<system> executes arguments as system command.
\n=head1 EXAMPLE

When system command line has only a command and arguments,
do like next.
\n=over 4

system ls -F

system vi fileList.txt
\n=back

When you want system shell functions, do like next.
\n=over 4

system \"ls > fileList.txt\"
\n=back
",
)->regist();

#===============================================================================
package ClamAV::Clamd;
#===============================================================================
#---------------------------------------
# モジュール
#---------------------------------------
# システム
use File::Spec;
use IO::Socket;
use threads;

# プロジェクト

#---------------------------------------
# グローバル変数宣言
#---------------------------------------

#---------------------------------------
# 定数
#---------------------------------------

#---------------------------------------
# メソッド
#---------------------------------------
sub new {
	my	$class = shift;
	my	%args = @_;
	my	$this = {
		'config'	=> {
			'LocalSocket'		=> undef,			# STRING
			'TCPSocket'			=> undef,			# NUMBER
			'TCPAddr'			=> undef,			# STRING
			'StreamMaxLength'	=> 10*1024*1024,	# SIZE
		},
		'option'	=> {
			'timeout'		=> 10,
			'bufsiz'		=> 4096,
		},
		'connection'	=> undef,
		'stream'		=> undef,
	};

	bless $this;
	foreach (keys %{$this->{'config'}}) {
		next	unless (defined $args{$_});
		$this->{'config'}->{$_} = $args{$_};
	}
	foreach (keys %{$this->{'option'}}) {
		next	unless (defined $args{$_});
		$this->{'option'}->{$_} = $args{$_};
	}

	return $this;
}

sub DESTROY {
	my	$this = shift;

	$this->closeStream();
	$this->close();
}

sub socketType {
	my	$this = shift;

	if (defined $this->{'config'}->{'LocalSocket'}) {
		return 'unix';
	}
	if (defined $this->{'config'}->{'TCPSocket'}) {
		return 'inet';
	}
	else {
		return undef;
	}
}

sub open {
	my	$this = shift;
	my	$socketType;
	my	$conn;

	if (defined($this->{'connection'}) and $this->{'connection'}->connected()) {
		return $this->{'connection'};
	}

	$socketType = $this->socketType();
	if (!defined($socketType)) {
		return undef;
	}
	elsif ($socketType eq 'unix') {
		$conn = IO::Socket::UNIX->new(
			Type 		=> IO::Socket::SOCK_STREAM,
			Peer 		=> $this->{'config'}->{'LocalSocket'},
		);
	}
	else {
		$conn = IO::Socket::INET->new(
			PeerAddr	=> $this->{'config'}->{'TCPAddr'}
				? $this->{'config'}->{'TCPAddr'}
				: '127.0.0.1'
			,
			PeerPort	=> $this->{'config'}->{'TCPSocket'},
			Proto		=> 'tcp',
			Type		=> IO::Socket::SOCK_STREAM,
			Timeout		=> $this->{'option'}->{'timeout'},
		);
	}
	$this->{'connection'} = $conn;

	unless ($this->{'connection'} and $this->{'connection'}->connected()) {
		$this->{'connection'} = undef;
	}

	return $this->{'connection'};
}

sub close {
	my	$this = shift;

	if (defined($this->{'connection'})) {
		$this->{'connection'}->close()	if ($this->{'connection'}->connected());
		$this->{'connection'} = undef;
	}
}

sub openStream {
	my	$this = shift;
	my	($port) = @_;

	if (defined($this->{'stream'}) and $this->{'stream'}->connected()) {
		return $this->{'stream'};
	}

	$this->{'stream'} = IO::Socket::INET->new(
		PeerAddr	=> $this->{'config'}->{'TCPAddr'}
			? $this->{'config'}->{'TCPAddr'}
			: '127.0.0.1'
		,
		PeerPort	=> $port,
		Proto		=> 'tcp',
		Type		=> IO::Socket::SOCK_STREAM,
		Timeout		=> $this->{'option'}->{'timeout'},
	);

	unless ($this->{'stream'} and $this->{'stream'}->connected()) {
		$this->{'stream'} = undef;
	}

	return $this->{'stream'};
}

sub closeStream {
	my	$this = shift;

	if (defined($this->{'stream'})) {
		$this->{'stream'}->close()	if ($this->{'stream'}->connected());
		$this->{'stream'} = undef;
	}
}

sub sendAll {
	my	$this = shift;
	my	($data) = @_;
	my	$len = length($data);
	my	$restLen = $len;
	my	$sentLen;

	$! = 0;
	for (; 0 < $restLen; $restLen -= $sentLen) {
		$sentLen = $this->{'connection'}->syswrite(
			substr($data, $len - $restLen, $restLen),
			$restLen
		);

		unless (defined $sentLen) {
			last;
		}
	}

	return $restLen;
}

sub sendAllStream {
	my	$this = shift;
	my	($data, $len) = @_;
	my	$restLen;
	my	$sentLen;

	$len = length($data)	unless (defined $len);
	$restLen = $len;

	$! = 0;
	for (; 0 < $restLen; $restLen -= $sentLen) {
		$sentLen = $this->{'stream'}->syswrite(
			substr($data, $len - $restLen, $restLen),
			$restLen
		);

		unless (defined $sentLen) {
			last;
		}
	}

	return $restLen;
}

sub recvAll {
	my	$this = shift;
	my	($ofh) = @_;
	my	$response = '';

	$! = 0;
	if (defined $ofh) {
		while (my $line = $this->{'connection'}->getline()) {
			printf {$ofh} $line;
			$response .= $line;
		}
	}
	else {
		while (my $line = $this->{'connection'}->getline()) {
			$response .= $line;
		}
	}

	return $response;
}

sub _cmd {
	my	$this = shift;
	my	($cmdLine, $ofh) = @_;
	my	$response = undef;

	$cmdLine .= "\n"	unless ($cmdLine =~ m/\n$/);
	if ($this->open()) {
		my	$restLen = $this->sendAll($cmdLine);

		$response = $this->recvAll($ofh)	if (
			defined($restLen) and $restLen == 0
		);
		$this->close();
	}

	return $response;
}

sub _cmdOneLine {
	my	$this = shift;
	my	($cmdLine) = @_;
	my	$response = undef;

	$cmdLine .= "\n"	unless ($cmdLine =~ m/\n$/);
	if ($this->open()) {
		my	$restLen = $this->sendAll($cmdLine);

		$response = $this->{'connection'}->getline()	if (
			defined($restLen) and $restLen == 0
		);
	}

	return $response;
}

sub ping {
	my	$this = shift;

	return $this->_cmd('PING');
}

sub version {
	my	$this = shift;

	return $this->_cmd('VERSION');
}

sub reload {
	my	$this = shift;

	return $this->_cmd('RELOAD');
}

sub shutdown {
	my	$this = shift;
	my	$response = undef;

	if ($this->open()) {
		my	$restLen = $this->sendAll("SHUTDOWN\n");

		$response = 1	if ($restLen == 0);
		$this->close();
	}

	return $response;
}

sub scan {
	my	$this = shift;
	my	($path, $ofh) = @_;

	return $this->_cmd("SCAN $path", $ofh);
}

sub rawscan {
	my	$this = shift;
	my	($path, $ofh) = @_;

	return $this->_cmd("RAWSCAN $path", $ofh);
}

sub contscan {
	my	$this = shift;
	my	($path, $ofh) = @_;

	return $this->_cmd("CONTSCAN $path", $ofh);
}

sub multiscan {
	my	$this = shift;
	my	($path, $ofh) = @_;

	return $this->_cmd("MULTISCAN $path", $ofh);
}

sub stream {
	my	$this = shift;
	my	($mode, $path, $ofh) = @_;
	my	$port = undef;
	my	$ok = 1;
	my	$response = undef;

	if (
		$ok
			and
		defined($port = $this->_cmdOneLine('STREAM'))
			and
		$port =~ m/^PORT (\d+)\s*$/
	) {
		$port = $1;

		if (CORE::open STREAM, $mode, $path) {
			if ($this->openStream($port)) {
				my	$data;
				my	$totalLen = 0;
				my	$redLen;
				my	$bufsiz = $this->{'option'}->{'bufsiz'};

				if ($this->{'config'}->{'StreamMaxLength'} < $bufsiz) {
					$bufsiz = $this->{'config'}->{'StreamMaxLength'};
				}

				while ($redLen = CORE::read(STREAM, $data, $bufsiz)) {
					my	$restLen;

					$restLen = $this->sendAllStream($data, $redLen);
					if (0 < $restLen) {
						$ok = 0;
						last;
					}
				}
				continue {
					$data = undef;
					$totalLen += $redLen;
					if (
						$this->{'config'}->{'StreamMaxLength'}
							<
						$totalLen + $bufsiz
					) {
						$bufsiz =
							$this->{'config'}->{'StreamMaxLength'} - $totalLen
						;
					}
				}
				$this->closeStream();
			}
			else {
				$ok = 0;
			}
			CORE::close STREAM;
		}
		else {
			$ok = 0;
		}
		$response = $this->recvAll($ofh)	if ($ok);
		$this->close();
	}
	else {
		$response = $port	if (defined $port);
	}

	return $response;
}

sub _sessionSender {
	my	$conn = shift;
	my	($fh, $recver) = @_;

	while (my $line = <$fh>) {
		my	$sentLen;

		chomp $line;
		if ($line =~ m/^END$/) {
			last;
		}
		$line .= "\n";
		threads->yield();
		$sentLen = $conn->syswrite($line, length($line));
		unless (defined $sentLen) {
			last;
		}
	}
	continue {
		threads->yield();
	}

	threads->yield();
	$conn->syswrite("END\n", length("END\n"));
}

sub session {
	my	$this = shift;
	my	($mode, $src, $ofh) = @_;
	my	$retVal = 1;

	if (CORE::open SESSION, $mode, $src) {
		if ($this->open()) {
			my	$restLen = $this->sendAll("SESSION\n");

			if (0 < $restLen) {
				$retVal = 0;
			}
			else {
				$this->{'sender'} = threads->new(
					\&_sessionSender, $this->{'connection'}, \*SESSION
				);

				$this->{'sender'}->detach;
				while (my $line = $this->{'connection'}->getline()) {
					print {$ofh} $line;
				}
			}

			$this->close();
			#$this->{'sender'} = undef;
		}
		CORE::close SESSION;
	}
	else {
		$retVal = 0;
	}

	return $retVal;
}

#---------------------------------------
# グローバル変数初期値
#---------------------------------------

#===============================================================================
package ClamAV::Shell::Command::Clamd;
#===============================================================================
#---------------------------------------
# モジュール
#---------------------------------------
# システム
use Getopt::Long	qw(GetOptionsFromArray);

# プロジェクト

#---------------------------------------
# グローバル変数宣言
#---------------------------------------
use vars qw(
	@ISA
);

#---------------------------------------
# 定数
#---------------------------------------
@ISA = qw(ClamAV::Shell::Command);

#---------------------------------------
# サブルーチン
#---------------------------------------

#---------------------------------------
# グローバル変数初期値
#---------------------------------------
ClamAV::Shell::Command->new(
	'name'	=> [qw(PING)],
	'func'	=> sub {
		my	$shell = shift;
		my	$term = $shell->terminal();
		my	$clamd = $shell->clamd();
		my	$response;

		unless (defined $clamd->socketType()) {
			$term->error("PING: clamd is not specified.\n");
			return;
		}

		$response = $clamd->ping();
		if (defined $response) {
			$term->print($response);
		}
		else {
			$term->errorf("PING: %s\n", "$!");
		}
	},
	'pod'	=> "=head1 NAME

PING - check clamd state.
\n=head1 SYNOPSIS

PING
\n=head1 DESCRIPTION

B<PING> sends PING clamd-command to current clamd.
And outputs it's response.
\n=head1 SEE ALSO

L<clamd(8)>",
)->regist();

ClamAV::Shell::Command->new(
	'name'	=> [qw(VERSION)],
	'func'	=> sub {
		my	$shell = shift;
		my	$term = $shell->terminal();
		my	$clamd = $shell->clamd();
		my	$response;

		unless (defined $clamd->socketType()) {
			$term->error("VERSION: clamd is not specified.\n");
			return;
		}

		$response = $clamd->version();
		if (defined $response) {
			$term->print($response);
		}
		else {
			$term->errorf("VERSION: %s\n", "$!");
		}
	},
	'pod'	=> "=head1 NAME

VERSION - print clamd and database versions.
\n=head1 SYNOPSIS

VERSION
\n=head1 DESCRIPTION

B<VERSION> sends VERSION clamd-command to current clamd.
And outputs it's response.\n\n=head1 SEE ALSO\n\nL<clamd(8)>",
)->regist();

ClamAV::Shell::Command->new(
	'name'	=> [qw(RELOAD)],
	'func'	=> sub {
		my	$shell = shift;
		my	$term = $shell->terminal();
		my	$clamd = $shell->clamd();
		my	$response;

		unless (defined $clamd->socketType()) {
			$term->error("RELOAD: clamd is not specified.\n");
			return;
		}

		$response = $clamd->reload();
		if (defined $response) {
			$term->print($response);
		}
		else {
			$term->errorf("RELOAD: %s\n", "$!");
		}
	},
	'pod'	=> "=head1 NAME

RELOAD - reload virus databaase.
\n=head1 SYNOPSIS

RELOAD
\n=head1 DESCRIPTION

B<RELOAD> sends RELOAD clamd-command to current clamd.
And outputs it's response.
\n=head1 SEE ALSO

L<clamd(8)>",
)->regist();

ClamAV::Shell::Command->new(
	'name'	=> [qw(SHUTDOWN)],
	'func'	=> sub {
		my	$shell = shift;
		my	$term = $shell->terminal();
		my	$clamd = $shell->clamd();

		unless (defined $clamd->socketType()) {
			$term->error("SHUTDOWN: clamd is not specified.\n");
			return;
		}

		if (!$clamd->shutdown()) {
			$term->errorf("SHUTDOWN: %s\n", "$!");
		}
	},
	'pod'	=> "=head1 NAME

SHUTDOWN - end clamd gracefully.
\n=head1 SYNOPSIS

SHUTDOWN
\n=head1 DESCRIPTION

B<SHUTDOWN> sends SHUTDOWN clamd-command to current clamd.
\n=head1 SEE ALSO

L<clamd(8)>",
)->regist();

ClamAV::Shell::Command->new(
	'name'	=> [qw(SCAN)],
	'func'	=> sub {
		my	$shell = shift;
		my	$term = $shell->terminal();
		my	$clamd = $shell->clamd();
		my	$ofh = $term->{'term'}->OUT ? $term->{'term'}->OUT : \*STDOUT;
		my	($path) = @_;
		my	$response;

		unless (defined $clamd->socketType()) {
			$term->error("SCAN: clamd is not specified.\n");
			return;
		}

		unless (defined $path) {
			$ClamAV::Shell::Command::Command{'SCAN'}->usage(
				$shell,
				-verbose => 0
			);
			return;
		}

		if ($path =~ m/\n/) {
			$path =~ s/\n/\\n/g;
			$term->errorf("SCAN: %s includes line feed.\n", $path);
			return;
		}

		$response = $clamd->scan($path, $ofh);
		unless ($response) {
			$term->errorf("SCAN: %s\n", "$!");
		}
	},
	'pod'	=> "=head1 NAME

SCAN - scan a file or directory with archive support enabled.
\n=head1 SYNOPSIS

SCAN I<path>
\n=head1 DESCRIPTION

B<SCAN> sends SCAN clamd-command to current clamd with I<path>.
And outputs it's response.
\n=head1 SEE ALSO

L<clamd(8)>",
)->regist();

ClamAV::Shell::Command->new(
	'name'	=> [qw(RAWSCAN)],
	'func'	=> sub {
		my	$shell = shift;
		my	$term = $shell->terminal();
		my	$clamd = $shell->clamd();
		my	$ofh = $term->{'term'}->OUT ? $term->{'term'}->OUT : \*STDOUT;
		my	($path) = @_;
		my	$response;

		unless (defined $clamd->socketType()) {
			$term->error("RAWSCAN: clamd is not specified.\n");
			return;
		}

		unless (defined $path) {
			$ClamAV::Shell::Command::Command{'RAWSCAN'}->usage(
				$shell,
				-verbose => 0
			);
			return;
		}

		if ($path =~ m/\n/) {
			$path =~ s/\n/\\n/g;
			$term->errorf("RAWSCAN: %s includes line feed.\n", $path);
			return;
		}

		$response = $clamd->rawscan($path, $ofh);
		unless ($response) {
			$term->errorf("RAWSCAN: %s\n", "$!");
		}
	},
	'pod'	=> "=head1 NAME

RAWSCAN - scan a file or directory with archive support dis-enabled.
\n=head1 SYNOPSIS

RAWSCAN I<path>
\n=head1 DESCRIPTION

B<SCAN> sends SCAN clamd-command to current clamd with I<path>.
And outputs it's response.
\n=head1 SEE ALSO

L<clamd(8)>",
)->regist();

ClamAV::Shell::Command->new(
	'name'	=> [qw(CONTSCAN)],
	'func'	=> sub {
		my	$shell = shift;
		my	$term = $shell->terminal();
		my	$clamd = $shell->clamd();
		my	$ofh = $term->{'term'}->OUT ? $term->{'term'}->OUT : \*STDOUT;
		my	($path) = @_;
		my	$response;

		unless (defined $clamd->socketType()) {
			$term->error("CONTSCAN: clamd is not specified.\n");
			return;
		}

		unless (defined $path) {
			$ClamAV::Shell::Command::Command{'CONTSCAN'}->usage(
				$shell,
				-verbose => 0
			);
			return;
		}

		if ($path =~ m/\n/) {
			$path =~ s/\n/\\n/g;
			$term->errorf("CONTSCAN: %s includes line feed.\n", $path);
			return;
		}

		$response = $clamd->contscan($path, $ofh);
		unless ($response) {
			$term->errorf("CONTSCAN: %s\n", "$!");
		}
	},
	'pod'	=> "=head1 NAME

CONTSCAN - SCAN which doesn't stop even if a virus is found.
\n=head1 SYNOPSIS

CONTSCAN I<path>
\n=head1 DESCRIPTION

B<CONTSCAN> sends CONTSCAN clamd-command to current clamd with I<path>.
And outputs it's response.
\n=head1 SEE ALSO

L<clamd(8)>",
)->regist();

ClamAV::Shell::Command->new(
	'name'	=> [qw(MULTISCAN)],
	'func'	=> sub {
		my	$shell = shift;
		my	$term = $shell->terminal();
		my	$clamd = $shell->clamd();
		my	$ofh = $term->{'term'}->OUT ? $term->{'term'}->OUT : \*STDOUT;
		my	($path) = @_;
		my	$response;

		unless (defined $clamd->socketType()) {
			$term->error("MULTISCAN: clamd is not specified.\n");
			return;
		}

		unless (defined $path) {
			$ClamAV::Shell::Command::Command{'MULTISCAN'}->usage(
				$shell,
				-verbose => 0
			);
			return;
		}

		if ($path =~ m/\n/) {
			$path =~ s/\n/\\n/g;
			$term->errorf("MULTISCAN: %s includes line feed.\n", $path);
			return;
		}

		$response = $clamd->multiscan($path, $ofh);
		unless ($response) {
			$term->errorf("MULTISCAN: %s\n", "$!");
		}
	},
	'pod'	=> "=head1 NAME

MULTISCAN - CONTSCAN using multiple threads.
\n=head1 SYNOPSIS

MULTISCAN I<path>
\n=head1 DESCRIPTION

B<SCAN> sends SCAN clamd-command to current clamd with I<path>.
And outputs it's response.
\n=head1 SEE ALSO

L<clamd(8)>",
)->regist();

ClamAV::Shell::Command->new(
	'name'	=> [qw(STREAM)],
	'func'	=> sub {
		my	$shell = shift;
		my	$term = $shell->terminal();
		my	$clamd = $shell->clamd();
		my	$src;
		my	$mode = '<';
		my	$response;

		unless (defined $clamd->socketType()) {
			$term->error("STREAM: clamd is not specified.\n");
			return;
		}

		unless (
			GetOptionsFromArray(\@_, 'c|command' => sub { $mode = '-|'; })
				and
			0 < scalar(@_)
		) {
			$ClamAV::Shell::Command::Command{'STREAM'}->usage(
				$shell,
				-verbose => 0
			);
			return;
		}
		$src = $_[0];

		$! = undef;
		$response = $clamd->stream($mode, $src);
		if (defined $response) {
			$term->print($response);
		}
		else {
			$term->errorf("STREAM: %s\n", "$!");
		}
	},
	'pod'	=> "=head1 NAME

STREAM - SCAN using stream.
\n=head1 SYNOPSIS

STREAM I<file>

STREAM -c|--command I<command>
\n=head1 DESCRIPTION

B<STREAM> sends STREAM clamd-command to current clamd.
And outputs the scan result.
It uses contents of I<file> or output of I<command> as stream data.

If the size of the stream data is larger than the value of variable
StreamMaxLength, B<STREAM> sends only N byte from the head of the stream data.
N is the value of variable StreamMaxLength.
\n=head1 SEE ALSO

L<clamd(8)>",
)->regist();

ClamAV::Shell::Command->new(
	'name'	=> [qw(SESSION)],
	'func'	=> sub {
		my	$shell = shift;
		my	$term = $shell->terminal();
		my	$clamd = $shell->clamd();
		my	$ofh = $term->{'term'}->OUT ? $term->{'term'}->OUT : \*STDOUT;
		my	$src;
		my	$mode = '<';
		my	$response;

		unless (defined $clamd->socketType()) {
			$term->error("SESSION: clamd is not specified.\n");
			return;
		}

		unless (
			GetOptionsFromArray(\@_, 'c|command' => sub { $mode = '-|'; })
				and
			0 < scalar(@_)
		) {
			$ClamAV::Shell::Command::Command{'STREAM'}->usage(
				$shell,
				-verbose => 0
			);
			return;
		}
		$src = $_[0];

		$response = $clamd->session($mode, $src, $ofh);
		unless ($response) {
			$term->errorf("SESSION: %s\n", "$!");
		}
	},
	'pod'	=> "=head1 NAME

SESSION - run multiple clamd-commands.
\n=head1 SYNOPSIS

SESSION I<file>

SESSION -c|--command I<command>
\n=head1 DESCRIPTION

B<SESSION> sends SESSION clamd-command to current clamd.
And outputs it's results.
It uses contents of I<file> or output of I<command> as clamd-commands list.
\n=head1 SEE ALSO

L<clamd(8)>",
)->regist();


ClamAV::Shell::Command->new(
	'name'	=> [qw(loadClamdConf)],
	'func'	=> sub {
	},
	'pod'	=> "=head1 NAME

loadClamdConf - load options from clamd.conf.
\n=head1 SYNOPSIS

loadClamdConf [I<file>]
\n=head1 DESCRIPTION

B<loadClamdConf> loads options from I<file> as F<clamd.conf>.
If I<file> is not given, B<loadClamdConf> uses the default F<clamd.conf>.
The default F<clamd.conf> is determined with following rules.
\n=over 4
\n=item rule-1

Default clamav base directory is F</usr/local>.
\n=item rule-2

If F<clamav-config> command exists in command-search-path,
clamav base directory is output of C<clamav-config --prefix>.
\n=item rule-3

Relative path of F<clamd.conf> from the clamav base directory is
F<etc/clamd.conf>.
\n=back
\n=head1 SEE ALSO

L<clamav-config(1)|clamav-config>, L<clamd.conf(5)|clamd.conf>"
)->regist();

#===============================================================================
package ClamAV::Shell;
#===============================================================================
#---------------------------------------
# モジュール
#---------------------------------------
# システム

# プロジェクト

#---------------------------------------
# グローバル変数宣言
#---------------------------------------

#---------------------------------------
# 定数
#---------------------------------------

#---------------------------------------
# メソッド
#---------------------------------------
sub new {
	my	$class = shift;
	my	($config, $term) = @_;
	my	$this = {
		'config'	=> undef,
		'terminal'	=> undef,
		'clamd'		=> undef,
		@_
	};

	unless (defined $this->{'config'}) {
		$this->{'config'} = ClamAV::Shell::Config->new();
	}
	unless (defined $this->{'terminal'}) {
		$this->{'terminal'} = ClamAV::Shell::Terminal->new($this->{'config'});
	}
	unless (defined $this->{'clamd'}) {
		$this->{'clamd'} = ClamAV::Clamd->new(
			%{$this->{'config'}->{'option'}}
		);
	}
	$this->{'config'}->{'optionHandler'} = sub {
		my	($name, $value, $oldValue) = @_;

		if (exists $this->{'clamd'}->{'config'}->{$name}) {
			$this->{'clamd'}->{'config'}->{$name} = $value;
		}
	};
	bless $this;

	return $this;
}

sub config {
	my	$this = shift;

	return $this->{'config'};
}

sub terminal {
	my	$this = shift;

	return $this->{'terminal'};
}

sub clamd {
	my	$this = shift;

	return $this->{'clamd'};
}

sub run {
	my	$this = shift;

	while (defined(my $line = $this->{'terminal'}->readline())) {
		$this->execute($line)	if ($line ne '');
	}
}

sub execute {
	my	$this = shift;
	my	@cmd = $this->interpret(shift);

	if (exists $ClamAV::Shell::Command::Command{$cmd[0]}) {
		$ClamAV::Shell::Command::Command{$cmd[0]}->do(
			$this, @cmd[1 .. $#cmd]
		);
	}
	else {
		$this->{'terminal'}->errorf("%s: command not found\n", $cmd[0]);
	}
}

sub interpret {
	my	$this = shift;
	my	$str = shift;
	my	@str;
	my	@interpreted = ();
	my	$status = 0;
	my	@args = ();

	unless (defined $str) {
		return ();
	}

	@str = split '', $str;
	for (my $i = 0; $i < scalar(@str); $i++) {
		# ニュートラル
		if ($status == 0) {
			if ($str[$i] eq '"') {
				$status = 1;	# ダブルクォート内へ
			}
			elsif ($str[$i] eq "'") {
				$status = 2;	# シングルクォート内へ
			}
			elsif ($str[$i] eq '\\') {
				$status = 3;	# エスケープへ
			}
			elsif ($str[$i] eq '$') {
				$status = 4;	# 変数名内へ
			}
			elsif ($str[$i] =~ m/\s/) {
				if (0 < scalar(@interpreted)) {
					push @args, join('', @interpreted);
					@interpreted = ();
				}
				$status = 5;	# 引数セパレータ内へ
			}
			elsif ($str[$i] eq '#') {
				last;
			}
			else {
				push @interpreted, $str[$i];
			}
		}
		# ダブルクォート内
		elsif ($status == 1) {
			if ($str[$i] eq '\\') {
				$status = 6;	# ダブルクォート内エスケープへ
			}
			elsif ($str[$i] eq '$') {
				$status = 7;	# ダブルクォート内変数名内へ
			}
			elsif ($str[$i] eq '"') {
				$status = 0;	# ニュートラルへ
			}
			else {
				push @interpreted, $str[$i];
			}
		}
		# シングルクオート内
		elsif ($status == 2) {
			if ($str[$i] eq '\\') {
				$status = 8;	# シングルクォート内エスケープへ
			}
			elsif ($str[$i] eq "'") {
				$status = 0;	# ニュートラルへ
			}
			else {
				push @interpreted, $str[$i];
			}
		}
		# エスケープ または ダブルクォート内エスケープ
		elsif ($status == 3 or $status == 6) {
			my	$subStr = join '', @str[$i .. $#str];

			if ($subStr =~ m/^(?#
				)([tnrfbae](?#				TAB や LF など
				)|[0-7]{1,3}(?#				八進数の文字コード
				)|x[\da-fA-F]{1,2}(?#		十六進数の文字コード
				)|x\{[\da-fA-F]{1,4}\}(?#	十六進数のワイド文字コード
				)|N\{[^}]*\}(?#				文字名
				)|c.(?#						コントロール文字
				)|l.(?#						一文字の小文字
				)|u.(?#						一文字の大文字
				)|L(?:[^\\]|\\[^E])*\\E(?#	小文字
				)|U(?:[^\\]|\\[^E])*\\E(?#	大文字
				)|Q(?:[^\\]|\\[^E])*\\E(?#	クォート
				))/
			) {
				my	$token = $1;
				my	$escaped;
				my	$unescaped;

				$escaped = $token;
				if (0 <= index($escaped, '"')) {
					my	$rest = $escaped;

					$escaped = '';
					while ($rest =~ m/\\*"/) {
						my	$prematch = $`;
						my	$match = $&;
						my	$postmatch = $';

						$escaped .= $prematch;
						if (length($match) % 2) {
							$escaped .= "\\".$match;
						}
						else {
							$escaped .= $match;
						}
						$rest = $postmatch;
					}
					$escaped .= $rest;
				}
				$escaped = '"\\'.$escaped.'"';
				$unescaped = eval "
					use charnames	qw(:full);
					$escaped;
				";

				push @interpreted, $unescaped;
				$i += length($token) - 1;
			}
			else {
				push @interpreted, $str[$i];
			}
			# ニュートラル または ダブルクォート内へ
			$status = $status == 3 ? 0 : 1;
		}
		# 変数名 または ダブルクォート内変数名
		elsif ($status == 4 or $status == 7) {
			my	$subStr = join '', @str[$i .. $#str];
			my	$name = undef;
			my	$value = undef;

			if ($subStr =~ m/^(\w+|\?)/) {
				$name = $1;
				$i += length($name) - 1;
			}
			elsif ($subStr =~ m/^{(\w+|\?)}/) {
				$name = $1;
				$i += length($name) + 2 - 1;
			}

			if (defined($name)) {
				$value = $this->{'config'}->get($name);
			}

			push @interpreted, defined($value) ? $value : '';
			# ニュートラル または ダブルクォート内へ
			$status = $status == 4 ? 0 : 1;
		}
		# 引数セパレータ内
		elsif ($status == 5) {
			if ($str[$i] =~ m/\S/) {
				$i--;
				$status = 0;	# ニュートラルへ
			}
		}
		# シングルクォート内エスケープ
		elsif ($status == 8) {
			unless ($str[$i] eq "'" or $str[$i] eq '\\') {
				push @interpreted, '\\'; 
			}
			push @interpreted, $str[$i];
			$status = 2;	# シングルクォート内へ
		}
	}
	# 不完全な終わり方をしている場合
	unless ($status == 0) {
		# ダブルクォートが開きっぱなしで終わっている場合
		if ($status == 1 or $status == 6 or $status == 7) {
			$this->{'terminal'}->error("Double quotation is not closed.\n");
		}
		# シングルクォートが開きっぱなしで終わっている場合
		if ($status == 2 or $status == 8) {
			$this->{'terminal'}->error("Single quotation is not closed.\n");
		}
		# エスケープされぱなしで終わっている場合
		if ($status == 3 or $status == 6 or $status == 8) {
			# 警告せずにエスケープを加える。
			push @interpreted, '\\';
		}
		# 変数が指示されぱなしで終わっている場合
		if ($status == 4 or $status == 7) {
			# 警告せずに $ を加える。
			push @interpreted, '$';
		}
		# 引き数セパレータ内で終わっている場合
		if ($status == 5) {
			# なにもしない
			1;
		}
	}
	push @args, join('', @interpreted);

	# 先頭の空白要素は省略する
	my	$i;

	for ($i = 0; $i < scalar(@args); $i++) {
		if ($args[$i] ne '') {
			last;
		}
	}
	if ($i == scalar(@args)) {
		@args = ();
	}
	else {
		@args = @args[$i .. $#args];
	}

	return @args;
}

#---------------------------------------
# グローバル変数初期値
#---------------------------------------

#===============================================================================
package main;
#===============================================================================
#---------------------------------------
# モジュール
#---------------------------------------
# システム
use Getopt::Long;
use Pod::Usage;

# プロジェクト

#---------------------------------------
# グローバル変数宣言
#---------------------------------------
use vars qw(
	$Version
	%Option
	$Config
);

#---------------------------------------
# 定数
#---------------------------------------
$Version = 'clamdsh.pl v2.0';

#---------------------------------------
# サブルーチン
#---------------------------------------
sub _InterpretValue {
	my	($optName, $value, $interpreter, $type) = @_;
	my	$parsedValue = &{$interpreter}($value);

	unless (defined $parsedValue) {
		pod2usage(
			-message	=> sprintf(
				'Value "%s" invalid for option %s (%s expected)',
				$value,
				$optName,
				$type
			),
			-output		=> \*STDERR,
			-exitval	=> 1,
			-verbose	=> 0,
		);
	}
	$Option{$optName} = $parsedValue;
}

sub InterpretStringValue {
	my	($optName, $value) = @_;

	_InterpretValue(
		$optName, $value,
		\&ClamAV::Clamd::Config::InterpretStringValue, 'STRING'
	);
}

sub InterpretNumberValue {
	my	($optName, $value) = @_;

	_InterpretValue(
		$optName, $value,
		\&ClamAV::Clamd::Config::InterpretNumberValue, 'NUMBER'
	);
}

sub InterpretSizeValue {
	my	($optName, $value) = @_;

	_InterpretValue(
		$optName, $value,
		\&ClamAV::Clamd::Config::InterpretSizeValue, 'SIZE'
	);
}

#---------------------------------------
# グローバル変数初期値
#---------------------------------------
%Option = ();

#---------------------------------------
# 引き数解釈
#---------------------------------------
GetOptions(
	\%Option,
	#--- ClamAV::Shell に渡すオプション ----
	'LocalSocket=s'		=> \&InterpretStringValue,
	'TCPSocket=i'		=> \&InterpretNumberValue,
	'TCPAddr=s'			=> \&InterpretStringValue,
	'StreamMaxLength=s'	=> \&InterpretSizeValue,
	'prompt=s'			=> \&InterpretStringValue,
	'timeout=i'			=> \&InterpretNumberValue,
	'bufsiz=s'			=> \&InterpretSizeValue,
	'histfile=s'		=> \&InterpretStringValue,
	'histsize=i'		=> \&InterpretNumberValue,
	#--- 情報表示 ----
	'help|h'	=> sub {
		pod2usage(
			-verbose	=> 2,
			-exitval	=> 0,
		)
	},
	'version'	=> sub {
		print <<EOF;
$Version
Copyright (C) 2007 OKAMURA Yuji.
This is free software; see the source for copying conditions. There is NO
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
EOF
		exit 0;
	},
) or pod2usage(
	-output		=> \*STDERR,
	-exitval	=> 1,
	-verbose	=> 0,
);

$Config = ClamAV::Shell::Config->new(%Option);

#---------------------------------------
# メイン
#---------------------------------------
{
	my	$shell = ClamAV::Shell->new('config' => $Config);

	$shell->run();
	$shell->terminal()->print("\n");
	$shell->terminal()->save();
#	$shell->config()->save();
}

__END__

=head1 NAME

clamdsh.pl - simple clamd shell.

=head1 SYNOPSIS

clamdsh.pl [--LocalSocket=I<socket>] [--TCPSocket=I<port>]
[--TCPAddr=I<address>] [--StreamMaxLength=I<stream-size>] [--prompt=I<prompt>]
[--timeout=I<sec>] [--bufsiz=I<buffer-size>] [--histofile=I<file>]
[--histsize=I<number-of-lines>]

clamdsh.pl [-h|--help]

clamdsh.pl [--version]

=head1 DESCRIPTION

B<clamdsh.pl> is a simple shell for clamd.

You can operate local/remote clamd with command-line base interface.
For detail see L</COMMAND ISSUE>, L</QUOTING>.
Additionary run B<clamdsh.pl> and type "help" and LF.

The configuration process of B<clamdsh.pl> is followings.

=over 4

=item 1. load system wide configuration.

B<clamdsh.pl> loads F</etc/clamdsh.conf>, if it exists.

=item 2. load clamd options from F<clamd.conf>.

B<clamdsh.pl> loads clamd options as self options from F<clamd.conf>.
When you want to know how to determine path of F<clamd.conf>, run B<clamdsh.pl>,
and type C<help loadClamdConf> and LF.

=back

=head1 OPTIONS

=over 4

=item --LocalSocket=I<socket>

Path to a local (Unix) socket clamd is listening on.

This is same with next internal command line.

=over 4

set LocalSocket I<socket>

=back

DEFAULT: (no)

=item --TCPSocket=I<port>

TCP port number clamd is listening on.

This is same with next internal command line.

=over 4

set TCPSocket I<port>

=back

DEFAULT: (no)

=item --TCPAddr=I<address>

TCP socket address clamd binding to.

This is same with next internal command line.

=over 4

set TCPAddr I<address>

=back

DEFAULT: (no)

=item --StreamMaxLength=I<stream-size>

clamd uses FTP-like protocol to receive stream data. This option allows you to
specify the upper limit for data size that will be transferred to clamd when
scanning a single file with STREAM command.

This is same with next internal command line.

=over 4

set StreamMaxLength I<stream-size>

=back

DEFAULT: 10M

=item --prompt=I<prompt>

I<prompt> is expanded and used as prompt string. See L</PROMPTING> bellow.

This is same with next internal command line.

=over 4

set prompt I<prompt>

=back

DEFAULT: '\{clamd}\$ '

=item --timeout=I<sec>

Timeout value for various operations of INET sockt.

This is same with next internal command line.

=over 4

set timeout I<sec>

=back

DEFAULT: 10

=item --bufsiz=I<buffer-size>

When STREAM clamd-command is issued, B<clamdsh.pl> use read/write buffer. It
reads data from specified file and keep them on the buffer, and it write them
to INET socket for clamd data port. You can specify the size of this buffer with
this option.

This is same with next internal command line.

=over 4

set bufsiz I<buffer-size>

=back

DEFAULT: 4096

=item --histfile=I<file>

history file.

DEFAULT: ~/.clamdsh.history

=item --histsize=I<number-of-lines>

history list size.

DEFAULT: 500

=item -h|--help

Display manual of B<clamdsh.pl>.

=item --version

Output version infomation of B<clamdsh.pl>.

=back

=head1 COMMAND ISSUE

A command line of B<clamdsh.pl> is a sequence by blank-separated words.
The first word specifies the command to issue.
The remaining words are aruguments to the invoked command.
Each command lines terminate with line feed.

It is just like a OS shell.
But B<clamdsh.pl> doesn't support multi lines command.
Backslash on end of line doesn't escape line feed,
double or single quote can't include line feeds.

You can display the list of commands by `help' command.

=head1 QUOTING

Single quotes and double quotes are used to remove the special meaning of
certain characters to the shell. They work like quotes in Perl and standard
Unix shell.
Double quoted literals are subject to variables and backslush substitution.
Single quoted literals are not subject except for "\'" and "\\". 

=over 4

SCAN /home/myname/Desktop/try and error

SCAN "/home/myname/Desktop/try and error"

=back

First command line has three arguments for SCAN. But second has only one.

=over 4

SCAN $PWD/clam.exe

SCAN "$PWD/clam.exe"

SCAN '$PWD/clam.exe'

=back

First and second command lines are same. But third is not same with others.

=over 4

SCAN ${PWD}/try\x20and\x20error

SCAN "${PWD}/try and error"

=back

Both command lines are same.

For detail, see perl documents such as perlop and perldata.

=head1 PROMPTING

B<clamdsh.pl> dsiplay the prompt when it is ready to read command.
B<clamdsh.pl> allows this prompt string to be customized by the variable
C<$prompt>.

In the value of C<$prompt>, you can use backslash-escaped special
charctors of L<bash(1)/PROMPTING> except "\l", "\s", "\[" and "\]".
Additionaly you can use the followings.

=over

=item \{LocalSocket}

Replace with current value of C<LocalSocket>.
If it is not set, null string.

=item \{TCPSocket}

Replace with current value of C<TCPSocket>.
If it is not set, null string.

=item \{TCPAddr}

Replace with current value of C<TCPAddr>.
If it is not set, null string.

=item \{StreamMaxLength}

Replace with current value of C<StreamMaxLength>.
If it is not set, null string.

=item \{timeout}

Replace with current value of C<timeout>.
If it is not set, null string.

=item \{bufsiz}

Replace with current value of C<bufsiz>.
If it is not set, null string.

=item \{clamd}

Replace with current socket for clamd. If it is not defined, "(no clamd)".
B<clamdsh.pl> primarily uses the value of C<LocalSocket> as UNIX domain socket
when C<LocalSocket> is set.
When C<LocalSocket> is not set and both of C<TCPAddr> and C<TCPSocket> are
set, B<clamdsh.pl> uses "$TCPAddr:$TCPSocket" as INET socket.

=back

NOTE: When you use terminal control escape sequences, it is interfered by
Term::ReadLine perl module control.

=head1 KNOWN PROBLEM

B<clamdsh.pl> dies on the following condition. 

=over 4

The value of C<StreamMaxLength> in B<clamdsh.pl> is greater than the value of
C<StreamMaxLength> in clamd.

AND STERAM command is used for the file.

AND size of the file is greater than the value of C<StreamMaxLength> in clamd.

=back

This problem can't be evaded. Use STREAM command carefully.

=head1 FILE

=over 4

=item /etc/clamdsh.conf

System wide configuration file.

This file contents is a hash of perl.
It determines default configurations.

If this file is not exists, B<clamdsh.pl> uses the following.

 (
     # personal configuration file spec.
     'config'    => {
         # path
         #   Because environment variable HOME is not defined
         #   according to the execution situation of clamdsh.pl,
         #   getpwuid is used. 
         'path'  => sprintf('%s/.clamdsh.conf',
             (getpwuid( $> ))[7]
         ),
         # permission
         'perm'  => 0600,
         # onwer
         'owner' => (getpwuid( $> ))[2],
         # owner group
         'group' => (getpwuid( $> ))[3],
     },
     # terminal spec.
     'terminal'  => {
         # terminal name
         'name'  => 'Clamd Shell',
         # input file handle. 
         'input' => \*STDIN,
         # output file handle. 
         'ouput' => \*STDOUT,
     },
     # default values of options.
     #   see "OPTIONS"
     'option'    => {
         # unix domain socket of clamd 
         'LocalSocket'       => undef,
         # port number of clamd server
         'TCPSocket'         => undef,
         # server address of clamd server
         'TCPAddr'           => undef,
         # limit bytes of data for STREAM clamd command
         'StreamMaxLength'   => 10*1024*1024,
         # prompt definition
         'prompt'            => '\{clamd}\$ ',
         # timeout for INET socket 
         'timeout'           => 10,
         # buffer size for STREAM clamd command 
         'bufsiz'            => 4096,
         # history file path
         #   Because environment variable HOME is not defined
         #   according to the execution situation of clamdsh.pl,
         #   getpwuid is used. 
         'histfile'  => sprintf('%s/.clamdsh.history',
             (getpwuid( $> ))[7]
         ),
         # number of line in history
         'histsize'  => 500,
     },
     # only internal use
     'optionHandler' => undef,
     # don't overwrite
     'status'    => {
         # current workin directory
         'PWD'   => getcwd,
         # home directory
         #   Because environment variable HOME is not defined
         #   according to the execution situation of clamdsh.pl,
         #   getpwuid is used. 
         'HOME'  => (getpwuid( $> ))[7],
     },
     # user defined variables
     'variable'  => {
         # name => value,
     },
 )

=item ~/.clamdsh.conf

Personal configuration file.
Variables which are set with set command are saved in this file.

=item ~/.clamdsh.history

Default command line history file.
You can change it with set command.

example:

=over 4

set histfile $HOME/clamdsh.history

=back

You can also change it with B<clamdsh.pl> option.

example:

=over 4

B<clamdsh.pl> --histfile="$HOME/clamdsh.history"

=back

=back

=head1 EXIT STATUS

0 - No error.

1 - Unknown option or bad option value is given.

=head1 SEE ALSO

L<clamd.conf(5)>, L<clamd(8)>, perlop, perldata, L<bash(1)>

=head1 AUTHOR

OKAMURA Yuji E<lt>https://sourceforge.jp/users/okamura/E<gt>
