Autore Topic: soket e synapse (Letto 9629 volte)

Diego1981 · « **il:** Marzo 14, 2017, 08:04:48 am »

per ricollegarmi alla discussione precedente, non capisco come mai ogni tanto ricevo un soket che non contine nulla (stringa vuota per essere chiaro) ma a cui viene assegnato il valore 4294967295

il server che attende il socket è tale e quale all'esempio http server della libreria synapse

procedure TServerThrd.Execute;
var
ClientSock:TSocket;
begin
with HttpServer do
try
CreateSocket;
setLinger(true,10000);
bind('0.0.0.0','7000');
listen;
repeat
if terminated then break;
if canread(1000) then
begin
ClientSock:=accept;
if lastError=0 then
TClientThrd.create(ClientSock);
end;
until false;
except
on E:Exception do
begin
Terminate;
FR_Principale.MM_Log.Lines.Add(E.ClassName+' errore, messaggio server: '+E.Message);
end;
end;
end;

"debuggando" dopo che avviene il fatto , alla riga " if canread(1000) then" ritorna sempre falso ed ho notato che è gia stato segnalato in rete ma non capisco come risolvere o almento gestire la situazione.

grazie

Stilgar · « **Risposta #1 il:** Marzo 14, 2017, 11:03:08 am »

Ciao Diego.
"TServerThrd" mi fa pensare che il "main" sia dentro un thread.

Il serverino che ho scritto ha come classe padre TCustomApplication.

Codice: [Seleziona]

  TWebApplication = class(TCustomApplication)
  private
    fContainer: TContainer;
    FPort: integer;
    FSocket: TTCPBlockSocket;
    function GetBaseDir: string;
    function GetDefaultIndex: string;
    procedure SetBaseDir(AValue: string);
    procedure SetDefaultIndex(AValue: string);
    procedure SetPort(AValue: integer);
  protected
    procedure DoRun; override;
  public
    procedure Initialize; override;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Port: integer read FPort write SetPort;
    property BaseDir: string read GetBaseDir write SetBaseDir;
    property DefaultIndex: string read GetDefaultIndex write SetDefaultIndex;
    property Environment: TContainer read fContainer;
  end;


  TWebDelegateThread = class(TThread)

Codice: [Seleziona]

procedure TWebApplication.DoRun;
var
  ClientSock: TSocket;
begin
  with FSocket do
  begin
    CreateSocket;
    setLinger(True, 10000);
    bind('0.0.0.0', IntToStr(FPort));
    listen;
    while not Terminated do
    begin
      if canread(1000) then
      begin
        ClientSock := accept;
        if lastError = 0 then
        begin
          TWebDelegateThread.Create(ClientSock, fContainer);
        end;
      end;
    end;
  end;
end;

Per l'index di test:

Codice: [Seleziona]

<html>
<head>
</head>
<body>
<script>
  window.open(location.href,'_blank');
</script>
</body>
</html>

Il server non ha problemi.
Il browser martella il server di richieste e ad ogni richiesta viene sganciato un thread, questo cerca il file e lo invia. Nel frattempo si fa una serie di giri mentali.

La differenza, credo, sta nel fatto che non apro un thread che sgancia altre thread?

Nota:
Sono partito dall'esempio che menzionavi. Forse è il test che è faccio a non essere così stressante come il tuo.

Stilgar

Diego1981 · « **Risposta #2 il:** Marzo 14, 2017, 11:14:51 am »

in effetti nella form principale con il pulsante di avvio ho inserito

interface

uses
Classes, SysUtils, FileUtil,....,....,....,ThrdServer;

FR_Principale = class(TForm)
....
....
....
....
private
{ private declarations }
Server:TServerThrd;
public
{ public declarations }
end;

procedure TFR_Principale.BT_AvviaServerClick(Sender: TObject);
begin
if Server=Nil then
begin
Server:=TServerThrd.Create;
.........
end;
end;

ora comunque provo la tua soluzione

Stilgar · « **Risposta #3 il:** Marzo 14, 2017, 12:43:32 pm »

Prova a mettere il "main" in una applicazione console

Diego1981 · « **Risposta #4 il:** Marzo 14, 2017, 01:32:12 pm »

urca...qui la vita si complica

Diego1981 · « **Risposta #5 il:** Marzo 15, 2017, 02:00:08 pm »

Ciao Stilgar
2 cose:

credo che il codice che hai scritto sia incompleto, nel senso che non lo hai copiato tutto
ho provato a mettere lo stesso codice che ti ho scritto nella applicazione, è molto piu fluido e veloce ma se provo a lanciare piu richieste da client diversi allo stesso tempo il socket 4294967295 si ripresenta

dimenticavo, l'errore si presenta quando ho delle pagine html leggermente elaborate (con un logo, liste, bottoni) quando sono leggere come la pagina di index dove ci sono due righe e un logo il problema non sembra presentarsi

Stilgar · « **Risposta #6 il:** Marzo 15, 2017, 02:02:49 pm »

Si Diego. E' un frammento

Tanto per dare l'idea

A questo punto sarebbe da capire il test come lo fai...

Stilgar

Diego1981 · « **Risposta #7 il:** Marzo 15, 2017, 02:07:27 pm »

apro 3 o 4 client su un paio di pc e faccio click nella stessa pagina HTML contemporaneamente su entrambi, a volte va e la maggior parte delle volte volte no

Stilgar · « **Risposta #8 il:** Marzo 15, 2017, 02:10:58 pm »

Quindi non ti sei scritto un programmino/script per bombardare il server...

Diego1981 · « **Risposta #9 il:** Marzo 15, 2017, 02:13:28 pm »

visto che con un paio di client va in crisi penso che un programmino sarebbe devastante
ti allego lo stamp di quello che accade quando succede l'errore
ad ogni execute del tread del client riporto il n di socket

Stilgar · « **Risposta #10 il:** Marzo 15, 2017, 02:38:58 pm »

Ciao Diego.
Ti ho mandato per mail il progetto.
Vedi se ti funziona.

Così mi verifichi la connessione multi pc :p

Stilgar

Diego1981 · « **Risposta #11 il:** Marzo 15, 2017, 02:48:08 pm »

intanto grazie
cerco di provare in giornata e ti faccio sapere

Stilgar · « **Risposta #12 il:** Marzo 15, 2017, 02:59:03 pm »

Occhio che la demo index.html fa impallare i browser con continue aperture di tab nuovi.

Uomo avvisato ...

Stilgar

Stilgar · « **Risposta #13 il:** Marzo 15, 2017, 04:26:12 pm »

Ciao
Piccolo eseguibile che scarica 100 thread alla ricerca di una pagina.
Giusto per vedere se crolla il serverino

Codice: [Seleziona]

program StressTest;

{$mode objfpc}{$H+}

uses {$IFDEF UNIX} {$IFDEF UseCThreads}
  cthreads, {$ENDIF} {$ENDIF}
  Classes,
  CustApp,
  httpsend,
  SysUtils;

type

  { TConnectionThread }

  TConnectionThread = class(TThread)
    procedure Execute; override;
  end;

  { TStressTest }

  TStressTest = class(TCustomApplication)
  protected
    FClients: array[0..99] of TConnectionThread;
    procedure DoRun; override;
  public
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
    procedure WriteHelp; virtual;
  end;

  { TConnectionThread }

  procedure TConnectionThread.Execute;
  var
    r: TStringList;
  begin
    r := TStringList.Create;
    Write('Server response');
    Writeln(HttpGetText('http://localhost:8081', r));
    r.Free;
    Terminate;
  end;

  { TStressTest }

  procedure TStressTest.DoRun;
  var
    t: TConnectionThread;
  begin
    Writeln('Executing ', Length(FClients), ' Connection Request');
    for t in FClients do
    begin
      t.Start;
    end;
    Writeln('Done ', Length(FClients), ' Connection Request');
    Terminate;
  end;


  constructor TStressTest.Create(TheOwner: TComponent);
  var
    t: TConnectionThread;
    i: integer;
  begin
    inherited Create(TheOwner);
    StopOnException := True;
    for i := Low(FClients) to High(FClients) do
    begin
      T := TConnectionThread.Create(True);
      FClients[i] := T;
    end;
    Writeln('Prepared ', Length(FClients), ' connection client for test');
  end;

  destructor TStressTest.Destroy;
  var
    T: TConnectionThread;
  begin
    for t in FClients do
    begin
      t.Free;
    end;
    inherited Destroy;
  end;

  procedure TStressTest.WriteHelp;
  begin
    { add your help code here }
    writeln('Usage: ', ExeName, ' -h');
  end;

var
  Application: TStressTest;

begin
  Application := TStressTest.Create(nil);
  Application.Initialize;
  Application.Title := 'ServerStressTest';
  Application.Run;
  Application.Free;
end.

Stilgar · « **Risposta #14 il:** Marzo 15, 2017, 06:56:36 pm »

Facciamo un pochino in conti :

Codice: [Seleziona]

program StressTest;

{$mode objfpc}{$H+}

uses {$IFDEF UNIX} {$IFDEF UseCThreads}
  cthreads, {$ENDIF} {$ENDIF}
  Classes,
  CustApp,
  httpsend,
  SysUtils;

type
  TTestCallback = procedure(Result: boolean) of object;
  { TConnectionThread }

  TConnectionThread = class(TThread)
  private
    FTestCallback: TTestCallback;
    FUrl: string;
    procedure SetTestCallback(AValue: TTestCallback);
    procedure SetUrl(AValue: string);
  public
    procedure Execute; override;
    property TestCallback: TTestCallback read FTestCallback write SetTestCallback;
    property Url: string read FUrl write SetUrl;
  end;

  { TStressTest }

  TStressTest = class(TCustomApplication)
  protected
    FTestCount: integer;
    FClients: array[0..99] of TConnectionThread;
    procedure DoRun; override;
    procedure TestCallback(Result: boolean);
  public
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
    procedure WriteHelp; virtual;
  end;

  { TConnectionThread }

  procedure TConnectionThread.Execute;
  var
    r: TStringList;
  begin
    r := TStringList.Create;
    if Assigned(FTestCallback) then
    begin
      FTestCallback(HttpGetText(FUrl, r));
    end
    else
    begin
      HttpGetText(FUrl, r);
    end;
    r.Free;
    Terminate;
  end;

  procedure TConnectionThread.SetTestCallback(AValue: TTestCallback);
  begin
    if FTestCallback = AValue then
    begin
      Exit;
    end;
    FTestCallback := AValue;
  end;

  procedure TConnectionThread.SetUrl(AValue: string);
  begin
    if FUrl = AValue then
    begin
      Exit;
    end;
    FUrl := AValue;
  end;

  { TStressTest }

  procedure TStressTest.DoRun;
  var
    t: TConnectionThread;
    testUrl: string;
  begin
    testUrl := 'http://localhost:8081';
    if ParamCount > 0 then
    begin
      testUrl := Params[1];
    end;
    for t in FClients do
    begin
      t.Url := testUrl;
      t.TestCallback := @TestCallback;
    end;
    Writeln('Executing ', Length(FClients), ' Connection Request');
    for t in FClients do
    begin
      t.Start;
    end;
    Writeln('Done ', Length(FClients), ' Connection Request');
    Terminate;
  end;

  procedure TStressTest.TestCallback(Result: boolean);
  var
    cs: TRTLCriticalSection;
  begin
    TryEnterCriticalsection(cs);
    if (Result) then
    begin
      Inc(FTestCount);
      Writeln('Completed test ok: ', FTestCount);
    end;
    LeaveCriticalsection(cs);
  end;


  constructor TStressTest.Create(TheOwner: TComponent);
  var
    t: TConnectionThread;
    i: integer;
  begin
    inherited Create(TheOwner);
    StopOnException := True;
    for i := Low(FClients) to High(FClients) do
    begin
      T := TConnectionThread.Create(True);
      FClients[i] := T;
    end;
    Writeln('Prepared ', Length(FClients), ' connection client for test');
  end;

  destructor TStressTest.Destroy;
  var
    T: TConnectionThread;
  begin
    for t in FClients do
    begin
      t.Free;
    end;
    inherited Destroy;
  end;

  procedure TStressTest.WriteHelp;
  begin
    { add your help code here }
    writeln('Usage: ', ExeName, ' -h');
  end;

var
  Application: TStressTest;

begin
  Application := TStressTest.Create(nil);
  Application.Initialize;
  Application.Title := 'ServerStressTest';
  Application.Run;
  Application.Free;
end.

News:

Privacy Policy

Blog italiano

Forum ufficiale

Lazarus 1.0

Progetti Lazarus

Free Pascal

Libri

Autore Topic: soket e synapse (Letto 9629 volte)

Recenti

How To

Free Pascal DS

Lazarus WEB

Disclaimer: