src/script/bcd.pl

   1 #!/usr/bin/perl -w
   2
   3 # This file is part of the breadcrumbs daemon (bcd).
   4 # Copyright (C) 2007 Pasqualino Ferrentino
   5
   6 # This program is free software; you can redistribute it and/or modify
   7 # it under the terms of the GNU General Public License as published by
   8 # the Free Software Foundation; either version 2 of the License, or
   9 # (at your option) any later version.
  10
  11 # This program is distributed in the hope that it will be useful, but
  12 # WITHOUT ANY WARRANTY; without even the implied warranty of
  13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  14 # General Public License for more details.
  15
  16 # You should have received a copy of the GNU General Public License
  17 # along with this program; if not, write to the Free Software
  18 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  19 # 02110-1301, USA.
  20
  21 # Contact: lino.ferrentino@yahoo.it (in Italian, English or German).
  22
  23 use strict;
  24 use warnings;
  25
  26 # use threads;
  27 # use threads::shared;
  28
  29 use FindBin;
  30 use lib("$FindBin::Bin/../lib");
  31
  32
  33 use Bcd::Errors::ErrorCodes;
  34 use Bcd::Clients::ClientsListeners;
  35
  36 use Carp; $SIG{__DIE__} = \&Carp::confess;
  37 use POSIX qw(setsid);
  38 #use IO::Socket::INET;
  39 #use IO::Select;
  40 #use DBI;
  41 #use User::pwent;
  42 #use Bcd::Bots::Manager;
  43 use Bcd::Clients::Listener;
  44
  45
  46 #use POSIX ":sys_wait_h";
  47 #use Getopt::Long;
  48 use Data::Dumper;
  49 use Pod::Usage;
  50 use constant {
  51     BCD_VERSION => '0.10.1.0',
  52 };
  53
  54 #$SIG{CHLD} = 'IGNORE';
  55
  56 #sub spawn;  # forward declaration
  57 #sub server;
  58
  59
  60 # flush the buffer
  61 #$| = 1;
  62
  63 # daemonize the program
  64 #&daemonize;
  65
  66 #my $test = 0;
  67 my $help = 0;
  68 my $script = 0;
  69 my $test = 1;
  70
  71 #let's see if the user wants to test...
  72 # GetOptions(
  73 #          'test'             => \$test,
  74 #          'help'             => \$help,
  75 #          'script'           => \$script,
  76 #          );
  77
  78
  79 #pod2usage(2) if $help;
  80
  81 # die "Cannot script without test" if ($script == 1 and $test == 0);
  82
  83 # my $PORT = 9000;                  # pick something not in use
  84
  85
  86 # if ($test){
  87 #     $PORT = 9001;
  88 #     print "----- Using test database, you can connect to port $PORT ----\n";
  89 #     Bcd::Clients::Listener->use_test_database();
  90 # } else {
  91 #     print "----- Using normal db, you can connect to port $PORT ----\n";
  92 # }
  93
  94 # my %files_to_delete;
  95 # my $queue_of_files_to_delete = new Thread::Queue;
  96
  97 # #the manager should be instantiated first of all, because it
  98 # #initializes the cache...
  99 # Bcd::Bots::Manager->instance($test);
 100 # my $clients_listeners = Bcd::Clients::ClientsListeners->instance
 101 #     ($script, \%files_to_delete, $queue_of_files_to_delete);
 102
 103
 104 # use constant EOL => "\015\012";
 105
 106
 107 # while(1) {
 108
 109
 110 #     my $server = IO::Socket::INET->new( Proto     => 'tcp',
 111 #                                    LocalPort => $PORT,
 112 #                                    Listen    => SOMAXCONN,
 113 #                                    Reuse     => 1);
 114
 115 #     die "can't setup server" unless $server;
 116 #     my $sel = new IO::Select($server);
 117
 118 #     print greetings();
 119 #     print "[Server $0 accepting clients]\n";
 120
 121 #     my @ready;
 122 #     while (1){
 123
 124 #       if (@ready = $sel->can_read(1)){
 125 #           foreach my $fh (@ready){
 126 #               my $client = $server->accept();
 127
 128 #               $client->autoflush(1);
 129
 130 #               {
 131 #                   $/ = "\015\012";
 132 #                   print $client greetings();
 133 #                   print $client EOL();
 134 #               }
 135
 136 #               my $name = gethostbyaddr($client->peeraddr, AF_INET);
 137 #               print "connection from $name [",inet_ntoa($client->peeraddr), "] at port $PORT\n";
 138 #               $clients_listeners->a_new_client_has_arrived($client);
 139
 140 #           }
 141 #       } else {
 142
 143 #           #print "nothing... let's see if there is a close pending\n";
 144 #           #ok, nothing has arrived, close the old channels...
 145 #           if ($queue_of_files_to_delete->pending() > 0){
 146
 147 #               #print $client "I want to quit you NOW $client\n";
 148 #               my $num = $queue_of_files_to_delete->dequeue();
 149 #               #print "................ I will delete  the $num \n";
 150 #               #print Dumper (\%files_to_delete);
 151 #               my $fh = delete $files_to_delete{$num};
 152 #               close $fh;
 153 #               undef $fh;
 154 #           }
 155
 156 #       }
 157 #     }
 158
 159 # }
 160
 161 use Bcd;
 162
 163 #print Dumper(\@ARGV);
 164
 165 #this creates the model and the command factory!
 166 Bcd::Data::Model->instance();
 167 #my $server = Bcd->new(port => $PORT, pid_file => './cippo.pid', setsid => 1);
 168 #my $server = Bcd->new(port => $PORT, pid_file => './cippo.pid', background => 1);
 169 my $server = Bcd->new(pid_file => './bcd.pid');
 170 $server->run();
 171
 172
 173
 174 sub spawn {
 175     my $client = shift;
 176
 177     my $pid;
 178     if (!defined($pid = fork)) {
 179         die "cannot fork: $!";
 180         return;
 181     } elsif ($pid) {
 182         return; # I'm the parent
 183     }
 184
 185     # else I'm the child -- go spawn
 186     exit main_client_parser($client);
 187 }
 188
 189 sub greetings{
 190
 191     my $ver = BCD_VERSION();
 192     my $greetings = "bcd version $ver, Copyright (C) 2007 Pasqualino Ferrentino\n";
 193     $greetings .=   "bcd comes with ABSOLUTELY NO WARRANTY; for details\n";
 194     $greetings .=   "see the file COPYING in the distribution directory.\n";
 195     $greetings .=   "This is free software, and you are welcome\n";
 196     $greetings .=   "to redistribute it under certain conditions;\n";
 197     $greetings .=   "see the file COPYING for details.\n";
 198
 199     return $greetings;
 200
 201 }
 202
 203
 204 sub daemonize {
 205     chdir '/'                 or die "Can't chdir to /: $!";
 206     open STDIN, '/dev/null'   or die "Can't read /dev/null: $!";
 207     #open STDOUT, '>>/dev/null' or die "Can't write to /dev/null: $!";
 208     open STDERR, '>>/dev/null' or die "Can't write to /dev/null: $!";
 209     defined(my $pid = fork)   or die "Can't fork: $!";
 210     exit if $pid;
 211     setsid                    or die "Can't start a new session: $!";
 212     umask 0;
 213 }
 214
 215 =head1 NAME
 216
 217     bcd.pl - Breadcrumbs daemon
 218
 219 =head1 SYNOPSIS
 220
 221     bcd.pl [options]
 222
 223  Options:
 224     --help           display this help and exits
 225     --test           use test database and test port (usually 9001)
 226     --script         write all the commands in a script file
 227
 228 =head1 DESCRIPTION
 229
 230 Run the bcd daemon, you should use it to run the breadcrumbs site.
 231
 232 =head1 AUTHOR
 233
 234 Pasqualino Ferrentino
 235
 236 =head1 COPYRIGHT
 237
 238 This library is free software, you can redistribute it and/or modify
 239 it under the same terms as Perl itself.
 240
 241 =cut