1 | #!/usr/bin/perl -w
|
---|
2 | use warnings;
|
---|
3 | use strict;
|
---|
4 | use Cwd;
|
---|
5 | use Sys::Hostname;
|
---|
6 | use IO::Socket;
|
---|
7 |
|
---|
8 | package main;
|
---|
9 | {
|
---|
10 | my (%console, @upstart, $active, $server);
|
---|
11 | local (%main::settings, %main::plugins, $main::socket);
|
---|
12 | my $port = $ARGV[0] || '51234';
|
---|
13 | $active = 1;
|
---|
14 | $|=1;
|
---|
15 |
|
---|
16 | #Intro Blurb
|
---|
17 | print "DIY Streetview Panorama capturer\nMade by: Joshua 'Boboon' Holland <http://www.theboboon.com>\nFor The University Of Waikato <http://www.cs.waikato.ac.nz>\nMany caffeinated beverages were harmed in the making of this software.\n-------------------------------\n";
|
---|
18 | #Just a Dash of awesomeness.
|
---|
19 | #Start the app
|
---|
20 | print "Loading plugins...\n";
|
---|
21 | &loadplugins;
|
---|
22 | print "Loading Console...\n";
|
---|
23 | &initconsole;
|
---|
24 | print "Doing Console Pre Execution Jobs...\n";
|
---|
25 | &runupstart;
|
---|
26 | $server = new IO::Socket::INET(LocalPort=>$port, Proto=>'tcp', Timeout=>20, Listen=>1, Reuse => 1) or die "Could not create socket: $!\n"; #Clients have 20 seconds to connect. Should be plenty of time, since Android devices die after 15 seconds.
|
---|
27 | setsockopt($server, SOL_SOCKET, SO_RCVTIMEO, pack('L!L!', +1800 ,0)); #Sometimes packet loss, and devices abnormally dying, will cause a server "Hang", now all connections are culled after 30 minutes of idling.
|
---|
28 | print "Started Command server on $port\n";
|
---|
29 | while ($active)
|
---|
30 | {
|
---|
31 | $main::socket = $server->accept();
|
---|
32 | if (defined $main::socket)
|
---|
33 | {
|
---|
34 | my $ip = $main::socket->peerhost();
|
---|
35 | print "Remote Client connected from: $ip\n";
|
---|
36 | &console;
|
---|
37 | print "Client $ip disconnected.\n";
|
---|
38 | }
|
---|
39 | }
|
---|
40 |
|
---|
41 | sub console
|
---|
42 | {
|
---|
43 | print "Console Loaded.\n";
|
---|
44 | while ($active == 1 && (my $in_line = <$main::socket>))
|
---|
45 | {
|
---|
46 | $in_line = lc($in_line);
|
---|
47 | my (@input);
|
---|
48 | $in_line =~ s/\r?\n$//;
|
---|
49 | print "[", $main::socket->peerhost(), "] CMD: '$in_line'\n";
|
---|
50 | if (!defined($in_line) || !length($in_line))
|
---|
51 | {
|
---|
52 |
|
---|
53 | }
|
---|
54 | else
|
---|
55 | {
|
---|
56 | @input = split(/\s?:/, $in_line);
|
---|
57 | my $cmd = shift(@input);
|
---|
58 | if ($cmd eq "help")
|
---|
59 | {
|
---|
60 | print $main::socket "Commands:\n";
|
---|
61 | while (my ($key, $value) = each(%console))
|
---|
62 | {
|
---|
63 | my $help = $value->help;
|
---|
64 | print $main::socket "'$key' is used to $help\n";
|
---|
65 | }
|
---|
66 | print $main::socket "'help' is used to show *This* prompt\n'exit' is used to generate a portal to Equestria. Jokes, it exits the application\n";
|
---|
67 | print $main::socket "Commands are not case sensitive\n";
|
---|
68 | }
|
---|
69 | elsif ($cmd eq "exit")
|
---|
70 | {
|
---|
71 | $active = 0;
|
---|
72 | close($main::socket);
|
---|
73 | print "Caught SIGEXIT. Shutting down server...\n";
|
---|
74 | }
|
---|
75 | elsif ($cmd eq "comms check")
|
---|
76 | {
|
---|
77 | print $main::socket "HELO\n"; #Allows Android devices to check if the connection works... A kind of "Handshake"
|
---|
78 | }
|
---|
79 | elsif (!$console{$cmd})
|
---|
80 | {
|
---|
81 | print $main::socket "Unknown command '$cmd'. It you need help type 'help' for a help prompt.\n";
|
---|
82 | }
|
---|
83 | else
|
---|
84 | {
|
---|
85 | $in_line =~ s/$cmd\s?:\s?//;
|
---|
86 | $console{$cmd}->do($in_line);
|
---|
87 | }
|
---|
88 | }
|
---|
89 | }
|
---|
90 | }
|
---|
91 |
|
---|
92 | sub initconsole
|
---|
93 | {
|
---|
94 | undef(%console);
|
---|
95 | my ($DIR, @files);
|
---|
96 | my $count_files = 0;
|
---|
97 | opendir ($DIR, "classes/console");
|
---|
98 | @files = grep(m/.*\.pm$/, readdir($DIR));
|
---|
99 | while (scalar(@files) > 0)
|
---|
100 | {
|
---|
101 | my $file = shift(@files);
|
---|
102 | require("classes/console/$file");
|
---|
103 | my $class = $file;
|
---|
104 | $class =~ s/\.pm//g;
|
---|
105 | my $obj = new $class();
|
---|
106 | $main::settings{lc($obj->command)} = $obj->defaultsettings;
|
---|
107 | $console{lc($obj->command)} = $obj;
|
---|
108 | if ($obj->doupstart())
|
---|
109 | {
|
---|
110 | push (@upstart, $obj)
|
---|
111 | }
|
---|
112 | }
|
---|
113 | closedir ($DIR);
|
---|
114 | print "Console initialized.\n"
|
---|
115 | }
|
---|
116 |
|
---|
117 | sub loadplugins
|
---|
118 | {
|
---|
119 | undef(%main::plugins);
|
---|
120 | my ($DIR, @files);
|
---|
121 | my $count_files = 0;
|
---|
122 | opendir ($DIR, "classes/plugins");
|
---|
123 | @files = grep(m/.*\.pm$/, readdir($DIR));
|
---|
124 | while (scalar(@files) > 0)
|
---|
125 | {
|
---|
126 | my $file = shift(@files);
|
---|
127 | require("classes/plugins/$file");
|
---|
128 | my $class = $file;
|
---|
129 | $class =~ s/\.pm//g;
|
---|
130 | my $obj = new $class();
|
---|
131 | $main::plugins{lc($obj->name)} = $obj;
|
---|
132 | $main::settings{lc($obj->name)} = $obj->defaultsettings;
|
---|
133 | if ($obj->doupstart())
|
---|
134 | {
|
---|
135 | push (@upstart, $obj)
|
---|
136 | }
|
---|
137 | print "Loaded Plugin '",$obj->name,"'...\n";
|
---|
138 | }
|
---|
139 | closedir ($DIR);
|
---|
140 | print "All plugins loaded.\n";
|
---|
141 | }
|
---|
142 |
|
---|
143 | sub runupstart
|
---|
144 | {
|
---|
145 | my $count_upstart = 0;
|
---|
146 | while ($count_upstart < scalar(@upstart))
|
---|
147 | {
|
---|
148 | $upstart[$count_upstart]->upstart;
|
---|
149 | $count_upstart++;
|
---|
150 | }
|
---|
151 | print "$count_upstart upstart jobs run.\n";
|
---|
152 | undef(@upstart); #It's never used again, and RAM is probably not all that large.
|
---|
153 | }
|
---|
154 | }
|
---|