program project1;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  sysutils, Classes, lnet, strutils, fgl
  { you can add units after this };

Var
  TEMP_DIR: String = '';

Function GetJSStr(Const aSource, aIndex: String): String;
Var
  aPos: Integer;
Begin
  aPos := Pos('"' + aIndex + '":"', aSource);
  If aPos = 0 Then Exit('');
  aPos := aPos + Length('"' + aIndex + '":"');
  Result := Copy(aSource, aPos, PosEx('"',aSource, aPos) - aPos);
end;

Type

{ BFileSocketClass }

 BFileSocketClass = Class
  Private
    bKind: String;
    bTempDir: String;
    bFileName: String;
    bFileSize: Integer;
    bSocket: TLSocket;
    bStream: TFileStream;
    Procedure BufferSend;
  Public
    Property Kind: String Read bKind;
    Property Stream: TFileStream Read bStream;
    Property Socket: TLSocket Read bSocket;
    Property FileName: String Read bFileName;
    Property FileSize: Integer Read bFileSize;

    Function Execute: Boolean;

    Constructor Build(Const aKind: String;
      Const aSocket: TLSocket; Const aFileName: String;
      Const aFileSize: Integer);
    Destructor Burn;
End;

Type

{ BServerClass }

 BServerClass = Class
  Private
    bConnection: TLTcp;
    bTerminated: Boolean;

    Procedure ProcessReceive(aSocket: TLSocket);
    Procedure ProcessDisconnect(aSocket: TLSocket);
    Procedure ProcessOnCanSend(aSocket: TLSocket);

    Function FileProcess(Const aSocket: TLSocket): Boolean;
    Procedure GetFile(Const aSocket: TLSocket; Const aName: String);
    Procedure PutFile(Const aSocket: TLSocket; Const aName: String;
      Const aSize: Integer);
  Public
    Procedure Run;
    Constructor Build;
    Destructor Burn;
End;

{ BFileSocketClass }

Procedure BFileSocketClass.BufferSend;
Var
  aCount: Integer;
  aBuffer: Array[0..2047] Of Byte;
  aSendCount: Integer;
Begin
  Repeat
    aCount := bStream.Read(aBuffer, 2048);
    If aCount > 0 Then
      Begin
        aSendCount := bSocket.Send(aBuffer, aCount);
        If Not(aSendCount = aCount) Then
          bStream.Seek(aSendCount - aCount, soFromCurrent);
      End;
  Until (aCount < 2048) Or Not(aSendCount = aCount);
End;

Function BFileSocketClass.Execute: Boolean;
Var
  aBuffer: Array [0..2047] Of Byte;
  aCount: Integer;
Begin
  Case Kind Of
    'PUT':
      Begin
        Result := FALSE;
        aCount := Socket.Get(aBuffer, 2048);
        if aCount > 0 Then
          bStream.Write(aBuffer, aCount);
        Result := bStream.Size = FileSize;
      End;
    'GET':
      Begin
        BufferSend;
        Result := bStream.Position = bStream.Size;
      End;
  End;
End;

Constructor BFileSocketClass.Build(Const aKind: String;
  Const aSocket: TLSocket; Const aFileName: String; Const aFileSize: Integer);
Begin
  bKind := aKind;
  bSocket := aSocket;
  bFileName := TEMP_DIR + ExtractFileName(aFileName);
  Case Kind Of
    'PUT':
      Begin
        bStream :=  TFileStream.Create(FileName, fmCreate);
        bFileSize := aFileSize;
      End;
    'GET':
      Begin
        bStream :=  TFileStream.Create(FileName, fmOpenRead);
        bFileSize := bStream.Size;
      End;
  End;
End;

Destructor BFileSocketClass.Burn;
Begin
  bStream.Free;
End;

{ BServerClass }

Procedure BServerClass.ProcessDisconnect(aSocket: TLSocket);
Begin
  If Not(aSocket.UserData = nil) Then
    Begin
      BFileSocketClass(aSocket.UserData).Burn;
      aSocket.UserData := nil;
    End;
end;

Procedure BServerClass.ProcessOnCanSend(aSocket: TLSocket);
Var
  aFileSocket: BFileSocketClass;
Begin
  If aSocket.UserData = nil Then Exit;
  aFileSocket := BFileSocketClass(aSocket.UserData);
  If aFileSocket.Execute Then
    Begin
      aSocket.UserData := nil;
      aFileSocket.Burn;
    End;
  bConnection.CallAction;
end;

Function BServerClass.FileProcess(Const aSocket: TLSocket): Boolean;
Var
  aFileSocket: BFileSocketClass;
Begin
  Result := FALSE;
  If aSocket.UserData = nil Then Exit;
  aFileSocket := BFileSocketClass(aSocket.UserData);
  If aFileSocket.Execute Then
    Begin
      aSocket.UserData := nil;
      aFileSocket.Burn;
    End;
  Result := TRUE
End;

Procedure BServerClass.ProcessReceive(aSocket: TLSocket);
var
  aType, aName, aMessage: String;
  aSize: Integer;
begin
  If Not(aSocket.UserData = nil) Then
  If FileProcess(aSocket) Then
    Begin
      bConnection.CallAction;
      Exit;
    End;
  If aSocket.GetMessage(aMessage) > 0 Then
    Begin
      aType := GetJSStr(aMessage, 'type');
      aName := GetJSStr(aMessage, 'name');
      aSize := StrToIntDef(GetJSStr(aMessage, 'size'), -1);
      Case aType Of
       'GET': GetFile(aSocket, aName);
       'PUT': PutFile(aSocket, aName, aSize);
      End;
    End;
end;

Procedure BServerClass.GetFile(Const aSocket: TLSocket; Const aName: String);
Var
  aFileSocket: BFileSocketClass;
  aResponse: String;
Begin
  aFileSocket := BFileSocketClass.Build('GET', aSocket, aName, -1);
  aSocket.UserData := aFileSocket;
  aResponse := Format('{"type":"GET","name":"%s","size":"%d"}',
    [aFileSocket.FileName, aFileSocket.FileSize]);
  aSocket.SendMessage(aResponse);
  If aFileSocket.Execute Then
    Begin
      aSocket.UserData := nil;
      aFileSocket.Burn;
    End;
End;

Procedure BServerClass.PutFile(Const aSocket: TLSocket; Const aName: String;
  Const aSize: Integer);
Var
  aRequest: String;
Begin
  aSocket.UserData := BFileSocketClass.Build('PUT', aSocket, aName, aSize);
  aRequest := Format('{"type":"PUT","name":"%s","size":"%d"}', [aName, aSize]);
  aSocket.SendMessage(aRequest);
End;

Procedure BServerClass.Run;
Begin
  If  bConnection.Listen(7447) Then
    Repeat
      bConnection.CallAction
    Until FALSE;
End;

Constructor BServerClass.Build;
Begin
  bTerminated := FALSE;
  bConnection := TLTcp.Create(nil);
  bConnection.OnReceive := @ProcessReceive;
  bConnection.OnDisconnect := @ProcessDisconnect;
  bConnection.OnCanSend := @ProcessOnCanSend;
  bConnection.Timeout := 1000;
End;

Destructor BServerClass.Burn;
Begin
End;

Begin
  TEMP_DIR := GetTempDir(FALSE) + 'upload/';
  If Not(DirectoryExists(TEMP_DIR)) Then mkdir(TEMP_DIR);
  With BServerClass.Build Do
    Begin
      Run;
      Burn;
    End;
end.