Wie verlasse ich TCustomApplication.Run via Shell anständig?

[theo]

Wenn ich einen Abkömmling von TCustomApplication habe (konkret THTTPApplication) und das Ding "läuft", befindet sich also im Run-Loop (Auf der Konsole), wie komme ich mit einem Unix Signal (INT, TERM, HUP bzw. Ctrl-C etc.) aus der Nummer raus, so dass ich noch z.B. etwas loggen kann, also, dass ich vom Abwürgen vorher noch Wind bekomme?

Oder allgemeiner: Wie verlasse ich TCustomApplication.Run via Shell Shortcut oder Task-Manager anständig?

Danke.

[Winni]

Hi!

Zuerst:

Code: Alles auswählen

TCustomApplication. Log(EventType : TEventType; const Msg : String);  

und dann

Code: Alles auswählen

TCustomApplication.Terminate;

Für Log gibt's auch ne Version mit Args : array of const und für Terminate eine mit ExitCode.

Steht alles in der unit Forms.

Winni

[theo]

Danke, aber ich glaube wir sprechen nicht vom Gleichen.

Dass ich innerhalb des Codes "Terminate" aufrufen kann (im gegebenen Moment, auch nicht immer) , ist mir schon klar.
Ich möchte aber auf ein Unix-Signal oder Ctrl-C auf der Shell reagieren können.

[Winni]

Hi!

Dafür gibt es in fpc den signal handler:

https://www.freepascal.org/docs-hml/rtl ... ction.html

Winni

[theo]

Danke, auch das weiß ich. Ich habe mir dafür früher schon eine rudimentäre Test-Unit gebastelt (Unten).
Das funktioniert auch anderweitig, nur passt das offenbar nicht zusammen mit dem Run Loop der THTTPApplication.
Die hängt beim Warten auf eine Verbindung und interessiert sich gar nicht für das Terminated Flag.
Offenbar entzieht man durch die Übernahme der Signal-Kontrolle der Anwendung auch die "übliche" Reaktion auf das Signal, oder anders gesagt, die Anwendung lässt sich dann nicht mehr mit Signalen "killen" sondern nur noch, indem man ihr die Konsole unter dem Hintern wegzieht..

Ich dachte halt, es gäbe einen offiziellen Weg, wie man so etwas löst, bzw aus Application.Run raus springt, evtl. mit einer Exception?

Code: Alles auswählen

unit UnixSignals;

{$mode objfpc}{$H+}

interface

uses BaseUnix, custapp;

const NumSig=4;

var
  CBreak, TermSignal, HangUp, User1Sig, User2Sig: Boolean;
  i:integer;
  sigarecarr:array[0..5] of psigactionrec;
  App:TCustomApplication;

implementation




procedure handleSignal(sig: cint); cdecl;
begin
  writeln('sigrecvd');
  case sig of
    SIGINT: CBreak:=True;
    SIGTERM: TermSignal:=True;
    SIGHUP: HangUp:=True;
    SIGUSR1: User1Sig:=True;
    SIGUSR2: User2Sig:=True;
  end;
  App.Terminate;
end;

procedure configureSignal(sig: cint; oa,na: psigactionrec);
begin
  na^.sa_handler:=sigactionhandler(@handleSignal);
  FillChar(na^.sa_mask, SizeOf(na^.sa_mask), #0);
  na^.sa_flags:=0;
  {$ifdef Linux}
  na^.sa_restorer:=Nil;
  {$endif}
  if FPSigaction(sig, na, oa) <> 0 then
  begin
    WriteLn('Unable to trap signal: ',sig);
    Halt(1);
  end;
end;

initialization
  CBreak:=False;
  TermSignal:=False;
  HangUp:=False;
  User1Sig:=False;
  User2Sig:=False;

  for i:=0 to (NumSig*2)-1 do New(sigarecarr[i]);

  configureSignal(SIGINT, sigarecarr[0], sigarecarr[1]);
  configureSignal(SIGTERM, sigarecarr[2], sigarecarr[3]);
  configureSignal(SIGHUP, sigarecarr[4], sigarecarr[5]);
  configureSignal(SIGUSR1, sigarecarr[6], sigarecarr[7]);

  finalization
  for i:=0 to (NumSig*2)-1 do Dispose(sigarecarr[i]);

end.

[Winni]

Hi!

Dann untersuch mal THTTPApplication.run was das treibt, wenn der Server nicht antworted. Da gehört natürlich im Sekundentakt ein Application.ProcessMessages rein . Kann Mozilla aber auch nicht. Lösung: Timeout auf kleinen Wert stellen und selber eine loop erzeugen. Oder nachsehen, ob ein Timer noch läuft, während er auf eine Verbindung wartet. Und den ein ProcessMessages ausführen lassen.

Jawohl: Wenn Du einen Signal Handler installiertst, dann ist der der einzige, der noch auf Unix signals reagiert. Aus ganz dunkler Erinnerung : man kann den auch derart patchen, dass er auch auf 9 und 15 reagiert. Hab ich mal vor ewigen Zeiten gemacht. Ich weiß aber gerade nicht mehr wo.

Winni

[Winni]

Hi!

* Du bist nicht allein: https://gitlab.com/freepascal.org/fpc/s ... sues/36741

* Und wenn du die THttpApplication in einen Thread packst??

Winni

[theo]

* Du bist nicht allein: https://gitlab.com/freepascal.org/fpc/s ... sues/36741

Danke! Den hatte ich nicht gesehen.
Ja, ist dann wohl so.
Ich wollte vor dem Suchen von Workarounds mich einfach mal umhören, was da los ist.
Und bei aller Dankbarkeit für die Programmierer von THTTPApplication und Vorfahren und allem Respekt:
Das ist alles schon sehr complicirt gelöst und so gut wie gar nicht dokumentiert.