1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
|
{
This file is part of the Free Pascal run time library.
Copyright (c) 2003 by the Free Pascal development team
Console and system log version of debug server.
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
{$mode objfpc}
{$h+}
program debugserver;
Uses
msgintf,debugserverintf,baseunix,classes,sysutils,getopts,systemlog;
resourcestring
SUnknownOption = 'Unknown option : %s';
SMessageFrom = '%s [%s] : %s ';
Var
UseSyslog : Boolean;
Const
LogLevel : Integer = log_debug;
Procedure LogEvent(Const Event: TDebugEvent);
Var
S : String;
begin
With Event do
begin
S:=DateTimeToStr(TimeStamp)+' : '+Format(SMessageFrom,[MsgTypes[LogCode],Client.Peer,Event]);
If UseSysLog then
Syslog(LogLevel,Pchar(S),[])
else
Writeln(S);
end;
end;
Function GetFDS(Var AFDS : tfdset) : Integer;
Var
I : Integer;
begin
Result:=0;
fpfd_zero(AFDS);
For I:=0 to FClients.Count-1 do
With TClient(FClients[i]) do
begin
If Handle>Result then
Result:=Handle;
fpfd_set(Handle,AFDS);
end;
Inc(Result);
end;
Procedure StartReading;
Var
ReadFDS : tfdset;
I,maxfds : Integer;
TimeOut : TTimeVal;
begin
Repeat
maxfds:=GetFDS(ReadFDS);
TimeOut.tv_sec:=0;
TimeOut.tv_usec:=10000;
Maxfds:=fpSelect(maxfds,@ReadFDS,Nil,Nil,@TimeOut);
If MaxFds>0 then
begin
For I:=FClients.Count-1 downto 0 do
If fpFD_IsSet(TClient(FClients[i]).Handle,ReadFDS)<>0 then
ReadMessage(TClient(FClients[i]).Handle);
end;
// Check for new connection.
CheckNewConnection;
Until (FClients.Count=0);
end;
procedure Wait;
Var
TV,TR : TimeSpec;
begin
tv.tv_sec:=1;
tv.tv_nsec:=0;
fpnanosleep(@tv,@tr);
end;
Procedure HandleConnections;
begin
Repeat
If CheckNewConnection<>Nil then
StartReading
else
Wait;
Until quit;
end;
Var
OldHUPHandler,
OldINTHandler,
OldQUITHandler,
OldTERMHandler : SigActionRec;
Procedure HandleSig(Sig : Longint); Cdecl;
Var
OH : Signalhandler;
begin
Quit:=True;
Case Sig of
SIGHUP : OH:=signalhandler(OldHUPHandler.sa_handler);
SIGTERM : OH:=signalhandler(OldTERMHandler.sa_handler);
SIGQUIT : OH:=signalhandler(OldQUITHandler.sa_handler);
SIGINT : OH:=signalhandler(OldINTHandler.sa_handler);
else
OH:=Nil;
end;
If (OH<>SignalHandler(SIG_DFL)) then
OH(Sig);
end;
Procedure SetupSignals;
Procedure SetupSig (Sig : Longint; Var OH : SigactionRec);
Var
Act : SigActionRec;
begin
signalhandler(Act.sa_handler):=@HandleSig;
fpsigemptyset(act.sa_mask);
Act.SA_FLAGS:=0;
{$ifdef linux} // ???
Act.Sa_restorer:=Nil;
{$endif}
if fpSigAction(Sig,@Act,@OH)=-1 then
begin
Writeln(stderr,SErrFailedToSetSignalHandler);
Halt(1)
end;
end;
begin
SetupSig(SIGTERM,OldTERMHandler);
SetupSig(SIGQUIT,OldQUITHandler);
SetupSig(SIGINT,OldINTHandler);
SetupSig(SIGHUP,OldHUPHandler);
end;
Procedure Usage;
begin
Writeln('Usage : debugserver [options]');
Writeln('where options is one of');
Writeln(' -h this help');
Writeln(' -s socket use unix socket');
Writeln(' -l uses syslog instead of standard output');
Halt(1);
end;
Procedure ProcessOptions;
Var
C : Char;
I : Integer;
begin
UseSyslog:=False;
Repeat
C:=getopt('hl::s:');
case c of
'h' : Usage;
's' : DebugSocket:=OptArg;
'l' : begin
UseSysLog:=True;
LogLevel:=StrToIntdef(OptArg,LogLevel);
end;
'?' : begin
Writeln(Format(SUnknownOption,[OptOpt]));
Usage;
end;
end;
Until (C=EndOfOptions);
if OptInd<=ParamCount then
begin
For I:=OptInd to ParamCount do
Writeln(Format(SUnknownOption,[Paramstr(i)]));
Usage;
end;
end;
Procedure SetupSysLog;
Var
Prefix : String;
begin
prefix:=format('DebugServer[%d] ',[fpGetPID]);
OpenLog(pchar(prefix),LOG_NOWAIT,LOG_DEBUG);
end;
Procedure CloseSyslog;
begin
CloseLog;
end;
begin
ProcessOptions;
SetupSignals;
If UseSysLog then
SetupSyslog;
OpenDebugServer;
DebugLogCallback:=@LogEvent;
Try
HandleConnections;
Finally
CloseDebugServer;
If UseSyslog then
CloseSyslog;
end;
end.
|
