Coro/myhttpd/shell.pl

# a server command shell

use EV;
use Coro;
use Coro::EV;
use Coro::Handle;
use Coro::Socket;
use Time::HiRes 'time';

use Text::Abbrev;

my $last_ts = time;

my %complete;
my @commands = qw(quit squit refresh country clrwhois restart block info print clrdiridx);

abbrev \%complete, @commands;

sub shell {
   my $fh = shift;

   while (defined (print $fh "cmd> "), $_ = $fh->readline) {
      s/\015?\012$//;
      if (s/^(\S+)\s*// && (my $cmd = $complete{$1})) {
         if ($cmd eq "quit") {
            print $fh "bye bye.\n";#d#
            last;
         } elsif ($cmd eq "squit") {
            print $fh "server quit.\n";#d#
            EV::unloop;
            last;
         } elsif ($cmd eq "print") {
            my @res = eval $_;
            print $fh "eval: $@\n" if $@;
            print $fh "RES = ", (join " : ", @res), "\n";
         } elsif ($cmd eq "block") {
            print "blocked '$_'\n";#d#
            $conn::blocked{$_} = [time + $::BLOCKTIME, "blocked by operator"];
         } elsif ($cmd eq "info") {
            $::NOW = time+1e-6;
            my @data;
            for (values %conn::conn) {
               for (values %$_) {
                  next unless $_;
                  my $rate = sprintf "%.1f", $_->{written} / ($::NOW - $_->{time});
                  push @data, "$_->{country}/$_->{remote_addr} $_->{written} $rate $_->{method} $_->{uri}\n";
               }
            }
            print $fh sort @data;
            print $fh scalar@data, " ($::conns) connections\n";#d#
            print $fh "$::written bytes written in the last ", $::NOW - $last_ts, " seconds\n";
            printf $fh "(%.1f bytes/s)\n", $::written / ($::NOW - $last_ts);
            ($last_ts, $::written) = ($::NOW, 0);
         } elsif ($cmd eq "refresh") {
            do "config.pl";
            print $fh "config.pl: $@\n" if $@;
            %statdata_cache = ();
            conn::read_blockuri;
            conn::read_blockref;
         } elsif ($cmd eq "clrdiridx") {
            %statdata_cache = ();
            delete $diridx{$_} for keys %diridx; # server error on %diridx = ();
         } elsif ($cmd eq "restart") {
            $::RESTART = 1;
            EV::unloop;
            print $fh "restarting, cu!\n";
            last;
         } elsif ($cmd eq "country") {
            print $fh netgeo::ip_request($_), "\n";
         } elsif ($cmd eq "clrwhois") {
            netgeo::clear_cache;
         }
      } else {
         print $fh "try one of @commands\n";
      }
   }
}

# bind to tcp port
if ($CMDSHELL_PORT) {
   my $port = new Coro::Socket
        #LocalAddr => "127.0.0.1",
        LocalPort => $CMDSHELL_PORT,
        ReuseAddr => 1,
        Listen => 1,
   or die "unable to bind cmdshell port: $!";

   push @listen_sockets, $port;

   async {
      while () {
         async \&shell, scalar $port->accept;
      }
   };
}

# bind to stdin (debug)
if (1) {
   my $tty;
   open $tty, "+</dev/tty"
      and async \&shell, unblock $tty;
}

Revision:	1.25
Committed:	Sat Jan 23 21:27:51 2010 UTC (16 years, 8 months ago) by root
Content type:	text/plain
Branch:	MAIN
CVS Tags:	rel-6_0, rel-6_5, rel-6_10, rel-6_09, rel-6_08, rel-6_07, rel-6_06, rel-6_05, rel-6_04, rel-6_03, rel-6_02, rel-6_01, rel-5_371, rel-5_372, rel-6_512, rel-6_513, rel-6_511, rel-6_514, rel-5_22, rel-5_23, rel-5_24, rel-5_25, rel-6_32, rel-6_33, rel-6_31, rel-6_36, rel-6_37, rel-6_38, rel-6_39, rel-5_37, rel-5_36, rel-6_23, rel-6_29, rel-6_28, rel-6_46, rel-6_45, rel-6_51, rel-6_52, rel-6_53, rel-6_54, rel-6_55, rel-6_56, rel-6_57, rel-6_43, rel-6_42, rel-6_41, rel-6_47, rel-6_44, rel-6_49, rel-6_48, HEAD
Changes since 1.24:	+3 -1 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	# a server command shell
2
3	root	1.23	use EV;
4	root	1.1	use Coro;
5	root	1.23	use Coro::EV;
6	root	1.1	use Coro::Handle;
7			use Coro::Socket;
8	root	1.8	use Time::HiRes 'time';
9
10	root	1.10	use Text::Abbrev;
11
12	root	1.8	my $last_ts = time;
13	root	1.1
14	root	1.10	my %complete;
15	root	1.25	my @commands = qw(quit squit refresh country clrwhois restart block info print clrdiridx);
16	root	1.10
17			abbrev \%complete, @commands;
18
19	root	1.1	sub shell {
20			my $fh = shift;
21
22	root	1.24	while (defined (print $fh "cmd> "), $_ = $fh->readline) {
23	root	1.2	s/\015?\012$//;
24	root	1.10	if (s/^(\S+)\s*// && (my $cmd = $complete{$1})) {
25			if ($cmd eq "quit") {
26	root	1.13	print $fh "bye bye.\n";#d#
27	root	1.10	last;
28			} elsif ($cmd eq "squit") {
29	root	1.13	print $fh "server quit.\n";#d#
30	root	1.23	EV::unloop;
31	root	1.11	last;
32	root	1.12	} elsif ($cmd eq "print") {
33	root	1.11	my @res = eval $_;
34			print $fh "eval: $@\n" if $@;
35			print $fh "RES = ", (join " : ", @res), "\n";
36	root	1.10	} elsif ($cmd eq "block") {
37			print "blocked '$_'\n";#d#
38	root	1.21	$conn::blocked{$_} = [time + $::BLOCKTIME, "blocked by operator"];
39	root	1.10	} elsif ($cmd eq "info") {
40			$::NOW = time+1e-6;
41			my @data;
42			for (values %conn::conn) {
43			for (values %$_) {
44			next unless $_;
45			my $rate = sprintf "%.1f", $_->{written} / ($::NOW - $_->{time});
46			push @data, "$_->{country}/$_->{remote_addr} $_->{written} $rate $_->{method} $_->{uri}\n";
47			}
48	root	1.1	}
49	root	1.10	print $fh sort @data;
50			print $fh scalar@data, " ($::conns) connections\n";#d#
51	root	1.19	print $fh "$::written bytes written in the last ", $::NOW - $last_ts, " seconds\n";
52	root	1.10	printf $fh "(%.1f bytes/s)\n", $::written / ($::NOW - $last_ts);
53			($last_ts, $::written) = ($::NOW, 0);
54			} elsif ($cmd eq "refresh") {
55	root	1.11	do "config.pl";
56			print $fh "config.pl: $@\n" if $@;
57	root	1.16	%statdata_cache = ();
58	root	1.18	conn::read_blockuri;
59			conn::read_blockref;
60	root	1.20	} elsif ($cmd eq "clrdiridx") {
61			%statdata_cache = ();
62	pcg	1.22	delete $diridx{$_} for keys %diridx; # server error on %diridx = ();
63	root	1.10	} elsif ($cmd eq "restart") {
64			$::RESTART = 1;
65	root	1.23	EV::unloop;
66	root	1.10	print $fh "restarting, cu!\n";
67			last;
68			} elsif ($cmd eq "country") {
69	root	1.17	print $fh netgeo::ip_request($_), "\n";
70	root	1.25	} elsif ($cmd eq "clrwhois") {
71			netgeo::clear_cache;
72	root	1.1	}
73			} else {
74	root	1.10	print $fh "try one of @commands\n";
75	root	1.1	}
76			}
77			}
78
79			# bind to tcp port
80			if ($CMDSHELL_PORT) {
81			my $port = new Coro::Socket
82	root	1.14	#LocalAddr => "127.0.0.1",
83	root	1.1	LocalPort => $CMDSHELL_PORT,
84			ReuseAddr => 1,
85			Listen => 1,
86			or die "unable to bind cmdshell port: $!";
87	root	1.2
88			push @listen_sockets, $port;
89	root	1.1
90			async {
91	root	1.7	while () {
92			async \&shell, scalar $port->accept;
93			}
94	root	1.1	};
95			}
96
97			# bind to stdin (debug)
98			if (1) {
99			my $tty;
100			open $tty, "+</dev/tty"
101			and async \&shell, unblock $tty;
102			}
103