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