lilalo

view l3-backend @ 100:2c00c61f2d7b

find changesets by author, revision, files, or words in the commit message
Коммичу изменения, но сам не знаю зачем.
Нужно l3-cgi переписать вообще с нуля.
Он мерзкий.

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