lilalo

annotate l3-backend @ 100:2c00c61f2d7b

Коммичу изменения, но сам не знаю зачем.
Нужно l3-cgi переписать вообще с нуля.
Он мерзкий.

И продумать нужно, как он вообще должен работать.
Понятно, приблизительно, как он должен показывать журнал,
когда до него уже дошли,
но вот если не дошли, то что делать не понятно.
Короче, продумать систему навигации.
author devi
date Wed Jun 14 21:37:22 2006 +0300 (2006-06-14)
parents 4c02cf4123ee
children 53b890d1ae90
rev   line source
devi@27 1 #!/usr/bin/perl
devi@27 2
devi@27 3 use strict;
devi@27 4 use lib '.';
devi@27 5 use l3config;
devi@27 6 use IO::Socket;
devi@27 7 use POSIX qw(:sys_wait_h);
devi@27 8
devi@27 9 sub main;
devi@27 10
devi@27 11 main();
devi@27 12
devi@27 13 sub REAPER {
devi@27 14 1 until (-1 == waitpid(-1, WNOHANG));
devi@27 15 $SIG{CHLD} = \&REAPER;
devi@27 16 }
devi@27 17
devi@27 18 sub process_was_killed
devi@27 19 {
devi@27 20 # Здесь должна быть красивая процедура
devi@27 21 # завершения демона
devi@27 22 unlink $Config{backend_pidfile};
devi@27 23 exit(0);
devi@27 24 }
devi@27 25
devi@27 26 sub main {
devi@27 27 init_config();
devi@27 28
devi@27 29
devi@27 30 # Проверяем, возможно демон уже запущен
devi@27 31 # Если он работает, просто завершаемся
devi@27 32 if (open(PIDFILE, $Config{backend_pidfile})) {
devi@27 33 my $pid = <PIDFILE>;
devi@27 34 close(PIDFILE);
devi@27 35 if ( ! -e "/proc/$pid" || !`grep $Config{"l3-backend"} /proc/$pid/cmdline && grep "uid:.*\b$<\b" /proc/$pid/status`) {
devi@27 36 print "Removing stale pidfile\n";
devi@27 37 unlink $Config{backend_pidfile}
devi@27 38 or die "Can't remove stale pidfile ". $Config{backend_pidfile}. " : $!";
devi@27 39 }
devi@27 40 else {
devi@27 41 print "l3-backend is already running\n";
devi@27 42 exit(0);
devi@27 43 }
devi@27 44 }
devi@27 45
devi@27 46 # Уходим в background, если необходимо
devi@27 47 if ($Config{detach} =~ /^y/i) {
devi@27 48 #$Config{verbose} = "no";
devi@27 49 my $pid = fork;
devi@27 50 exit if $pid;
devi@27 51 die "Couldn't fork: $!" unless defined ($pid);
devi@27 52
devi@27 53 open(PIDFILE, ">", $Config{backend_pidfile})
devi@27 54 or die "Can't open pidfile ". $Config{backend_pidfile}. " for wrting: $!";
devi@27 55 print PIDFILE $$;
devi@27 56 close(PIDFILE);
devi@27 57
devi@27 58 for my $handle (*STDIN, *STDOUT, *STDERR) {
devi@27 59 open ($handle, "+<", "/dev/null")
devi@27 60 or die "can't reopen $handle to /dev/null: $!"
devi@27 61 }
devi@27 62
devi@27 63 POSIX::setsid()
devi@27 64 or die "Can't start a new session: $!";
devi@27 65
devi@27 66 $0 = $Config{"l3-backend"};
devi@27 67
devi@27 68 $SIG{INT} = $SIG{TERM} = $SIG{HUP} = \&process_was_killed;
devi@27 69 }
devi@27 70
devi@27 71 # Открываем сетевой сокет и слушаем
devi@27 72 my $server = IO::Socket::INET->new(
devi@27 73 LocalPort => $Config{backend_port},
devi@27 74 Type => SOCK_STREAM,
devi@27 75 Reuse => 1,
devi@27 76 Listen => 10 );
devi@27 77
devi@27 78 if (!$server) {
devi@27 79 die "Couldn't bind to socket ".$Config{backend_port}."\n";
devi@27 80 }
devi@27 81
devi@27 82 $SIG{CHLD} = 'IGNORE';
devi@27 83
devi@27 84 # При получении новых соединенений,
devi@27 85 # порождаем дочерние процессы
devi@27 86 while (my $client = $server->accept()) {
devi@27 87 my $pid;
devi@27 88 next if $pid = fork;
devi@27 89 die "fork: $!" unless defined $pid;
devi@27 90
devi@27 91 # Это наш ответвлённый клиент
devi@27 92 close($server);
devi@27 93
devi@98 94 my $saved_data = "";
devi@98 95
devi@27 96 # Считываем данные и передаём их в точку получения
devi@27 97 open(OUT, ">>", $Config{"backend_datafile"});
devi@27 98 select OUT; $|=1;
devi@27 99 while(<$client>) {
devi@27 100 print OUT $_;
devi@98 101 $saved_data .= $_;
devi@27 102 }
devi@27 103 close(OUT);
devi@98 104
devi@99 105 #open(LOG, ">>", "/tmp/l3-backend.log");
devi@99 106 #print LOG "Saved data:$saved_data\n";
devi@99 107 #close(LOG);
devi@99 108
devi@99 109 while ($saved_data =~ m@<(session|command)>(.*)</\1>@sg) {
devi@99 110
devi@99 111 #open(LOG, ">>", "/tmp/l3-backend.log");
devi@99 112 #print LOG "Found element $1\n";
devi@99 113 #close(LOG);
devi@99 114
devi@98 115 my $element_name = $1;
devi@98 116 my $element = $2;
devi@98 117 if ($element =~ m@<l3cd>(.*?)</l3cd>@msg) {
devi@98 118 # Обнаружен элемент l3cd
devi@98 119 # Информация должна быть сохранена в соответствующий каталог
devi@98 120 my $l3cd = $1;
devi@98 121 # Путь l3cd должен быть не пуст,
devi@98 122 # и в нём могут быть только символы латинского алфавита, цифры и знаки _ и -
devi@98 123 if ($l3cd && $l3cd =~ /^[a-zA-Z_\/0-9-]*/) {
devi@98 124 system("mkdir -p $Config{backend_datadir}/$l3cd");
devi@98 125 if (open(OUT, ">>", $Config{"backend_datadir"}."/$l3cd/data.xml")) {
devi@98 126 print OUT "<$element_name>".$element."</$element_name>";
devi@98 127 close(OUT);
devi@98 128 };
devi@98 129 }
devi@98 130 }
devi@98 131 }
devi@27 132 }
devi@27 133 continue {
devi@27 134 # Наш родитель
devi@27 135 close ($client);
devi@27 136 }
devi@27 137 }