123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201 |
- {lsocket.pas}
-
- {signal code by plugwash}
-
- { Copyright (C) 2005 Bas Steendijk and Peter Green
- For conditions of distribution and use, see copyright notice in zlib_license.txt
- which is included in the package
- ----------------------------------------------------------------------------- }
-
- unit lsignal;
- {$mode delphi}
- interface
- uses sysutils,
- {$ifdef VER1_0}
- linux,
- {$else}
- baseunix,unix,unixutil,
- {$endif}
- classes,lcore,lloopback;
-
- type
- tsignalevent=procedure(sender:tobject;signal:integer) of object;
- tlsignal=class(tcomponent)
- public
- onsignal : tsignalevent ;
- prevsignal : tlsignal ;
- nextsignal : tlsignal ;
-
- constructor create(aowner:tcomponent);override;
- destructor destroy;override;
- end;
-
-
- procedure starthandlesignal(signal:integer);
-
- var
- firstsignal : tlsignal;
- blockset : sigset;
- signalloopback : tlloopback ;
-
- implementation
- {$include unixstuff.inc}
-
- constructor tlsignal.create;
- begin
- inherited create(AOwner);
- nextsignal := firstsignal;
- prevsignal := nil;
-
- if assigned(nextsignal) then nextsignal.prevsignal := self;
- firstsignal := self;
-
- //interval := 1000;
- //enabled := true;
- //released := false;
- end;
-
- destructor tlsignal.destroy;
- begin
- if prevsignal <> nil then begin
- prevsignal.nextsignal := nextsignal;
- end else begin
- firstsignal := nextsignal;
- end;
- if nextsignal <> nil then begin
- nextsignal.prevsignal := prevsignal;
- end;
- inherited destroy;
- end;
- {$ifdef linux}
- {$ifdef ver1_9_8}
- {$define needsignalworkaround}
- {$endif}
- {$ifdef ver2_0_0}
- {$define needsignalworkaround}
- {$endif}
- {$ifdef ver2_0_2}
- {$define needsignalworkaround}
- {$endif}
- {$endif}
- {$ifdef needsignalworkaround}
- //using the 1.9.6 version of this stuff because the 1.9.8 and 2.0.0 versions seem broken
- type
- TSysParam = Longint;
- TSysResult = longint;
- const
- syscall_nr_sigaction = 67;
- //function Do_SysCall(sysnr:TSysParam):TSysResult; {$ifndef VER1_0} oldfpccall; {$endif} external name 'FPC_SYSCALL0';
- //function Do_SysCall(sysnr,param1:TSysParam):TSysResult; {$ifndef VER1_0} oldfpccall; {$endif} external name 'FPC_SYSCALL1';
- //function Do_SysCall(sysnr,param1,param2:TSysParam):TSysResult; {$ifndef VER1_0} oldfpccall; {$endif} external name 'FPC_SYSCALL2';
- function Do_SysCall(sysnr,param1,param2,param3:TSysParam):TSysResult; {$ifndef VER1_0} oldfpccall; {$endif} external name 'FPC_SYSCALL3';
- //function Do_SysCall(sysnr,param1,param2,param3,param4:TSysParam):TSysResult; {$ifndef VER1_0} oldfpccall; {$endif} external name 'FPC_SYSCALL4';
- //function Do_SysCall(sysnr,param1,param2,param3,param4,param5:TSysParam):TSysResult; {$ifndef VER1_0} oldfpccall; {$endif} external name 'FPC_SYSCALL5';
-
- function Fpsigaction(sig: cint; act : psigactionrec; oact : psigactionrec): cint;// [public, alias : 'FPC_SYSC_SIGACTION'];
- {
- Change action of process upon receipt of a signal.
- Signum specifies the signal (all except SigKill and SigStop).
- If Act is non-nil, it is used to specify the new action.
- If OldAct is non-nil the previous action is saved there.
- }
- begin
- //writeln('fucking');
- {$ifdef RTSIGACTION}
- {$ifdef cpusparc}
- { Sparc has an extra stub parameter }
- Fpsigaction:=do_syscall(syscall_nr_rt_sigaction,TSysParam(sig),TSysParam(act),TSysParam(oact),TSysParam(PtrInt(@Fprt_sigreturn_stub)-8),TSysParam(8));
- {$else cpusparc}
- Fpsigaction:=do_syscall(syscall_nr_rt_sigaction,TSysParam(sig),TSysParam(act),TSysParam(oact),TSysParam(8));
- {$endif cpusparc}
- {$else RTSIGACTION}
- //writeln('nice');
- Fpsigaction:=do_syscall(syscall_nr_sigaction,TSysParam(sig),TSysParam(act),TSysParam(oact));
- {$endif RTSIGACTION}
- end;
- {$endif}
-
- // cdecl procedures are not name mangled
- // so USING something unlikely to cause colliesions in the global namespace
- // is a good idea
- procedure lsignal_handler( Sig : Integer);cdecl;
- var
- currentsignal : tlsignal;
- begin
- // writeln('in lsignal_hanler');
- currentsignal := firstsignal;
- while assigned(currentsignal) do begin
- if assigned(currentsignal.onsignal) then currentsignal.onsignal(currentsignal,sig);
- currentsignal := currentsignal.nextsignal;
-
- end;
- // writeln('about to send down signalloopback');
- if assigned(signalloopback) then begin
- signalloopback.sendstr(' ');
- end;
- // writeln('left lsignal_hanler');
- end;
-
- {$ifdef freebsd}
-
- {$if (FPC_VERSION > 2) or ((FPC_VERSION = 2) and (FPC_RELEASE >= 2))}
- procedure lsignal_handler2(signal:longint;info:PSigInfo;context:psigcontext); cdecl;
- {$else}
- procedure lsignal_handler2(signal:longint;var info:TSigInfo_t;var context:SigContextRec); cdecl;
- {$endif}
-
- begin
- lsignal_handler(signal);
- end;
- {$endif}
-
-
- const
- allbitsset=-1;
- {$ifdef ver1_0}
- saction : sigactionrec = (handler:(sh:lsignal_handler);sa_flags:0);
- {$else}
- {$ifdef darwin}
- saction : sigactionrec = (sa_handler:tsigaction(lsignal_handler);sa_flags:0);
- {$else}
- {$ifdef freebsd}
- //version number is FPC_VERSION.FPC_RELEASE.FPC_PATCH
- {$if (FPC_VERSION>2) or ((FPC_VERSION=2) and (FPC_RELEASE>0)) or ((FPC_VERSION=2) and (fpc_release=0) and (fpc_patch>=2))}
- saction : sigactionrec = (sa_handler:lsignal_handler2;sa_flags:0);
- {$else}
- saction : sigactionrec = (sa_handler:tsigaction(lsignal_handler);sa_flags:0);
- {$endif}
-
- {$else}
- {$ifdef ver1_9_2}
- saction : sigactionrec = (handler:(sh:lsignal_handler);sa_flags:0);
- {$else}
- //version number is FPC_VERSION.FPC_RELEASE.FPC_PATCH
- {$if (FPC_VERSION>2) or ((FPC_VERSION=2) and (FPC_RELEASE>0)) or ((FPC_VERSION=2) and (fpc_release=0) and (fpc_patch>=2))}
- saction : sigactionrec = (sa_handler:{$ifndef ver1_9_6}{$ifndef ver1_9_4}{$ifndef ver1_0}SigActionHandler{$endif}{$endif}{$endif}(lsignal_handler);sa_flags:0;sa_restorer:nil);
- {$else}
- saction : sigactionrec = (sa_handler:{$ifndef ver1_9_6}{$ifndef ver1_9_4}{$ifndef ver1_0}SigActionHandler{$endif}{$endif}{$endif}(lsignal_handler));
- {$endif}
- {$endif}
- {$endif}
- {$endif}
- {$endif}
- procedure starthandlesignal(signal:integer);
- begin
- if signal in ([0..31]-[sigkill,sigstop]) then begin
- sigprocmask(SIG_BLOCK,@blockset,nil);
- sigaction(signal,@saction,nil)
- end else begin
- raise exception.create('invalid signal number')
- end;
- end;
-
- initialization
- fillchar(blockset,sizeof(blockset),0);
- blockset[0] := $FFFFFFFF - (1 shl sigstop) - (1 shl sigkill) - (1 shl sigsegv);
- {$ifdef ver1_0}
- saction.sa_mask := blockset[0];
- {$else}
- saction.sa_mask := blockset;
- {$endif}
- end.
|