IPB

Здравствуйте, гость ( Вход | Регистрация )

 
Ответить в эту темуОткрыть новую тему
> Авторизатор в виде сервиса
grig27
сообщение 2.11.2010, 23:22
Сообщение #1





Группа: Пользователи
Регистрация: 29.6.2006
Пользователь №: 13 144



Доброго времени суток! Имеются наработки по этому поводу. Есть ли интерес к данной теме?
Вернуться в начало страницы
 
+Ответить с цитированием данного сообщения
L o k i
сообщение 3.11.2010, 11:21
Сообщение #2





Группа: Пользователи
Регистрация: 13.2.2007
Из: Чермет
Пользователь №: 20 753



Интерес есть. Продолжайте мысль.
Вернуться в начало страницы
 
+Ответить с цитированием данного сообщения
grig27
сообщение 4.11.2010, 01:08
Сообщение #3





Группа: Пользователи
Регистрация: 29.6.2006
Пользователь №: 13 144



Код портирован с линукс авторизатора

Класс можно использовать в сервисе или в собственном приложении

Что не понятно пишите.

Код
unit lanautht;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, koCommon, libeay32, Buttons, WinSock2, RTLConsts;

const
  SERVER_ADDRESS = '10.0.0.1';
  SERVER_PORT = 8314;
  ACCESS_LEVEL: Byte = 2;
  MIN_CONNECT_INTERVAL = 10000;
  MAX_RECEIVE_INTERVAL = 10000;
  CONNECT_PERIOD = 3600000;
  MAX_CONNECT_COUNT = 10;
  AUTH_INTERVAL = 3000;
  CHALLENGE_INTERVAL = 300000;

type
    ESocketError = class(Exception);
  TLanauthThread = class;
  TLanauthNotifyEvent = procedure (Sender: TLanauthThread) of object;
  TLanauthSocketEvent = procedure (Sender: TLanauthThread;
      AResultCode: Integer; const AOp: string) of object;
  TLanauthErrorEvent = procedure (Sender: TLanauthThread; ASocketError: Integer) of object;
  TLanauthExceptionEvent = procedure (Sender: TLanauthThread; AMessage: String) of object;
  TLanauthPrintEvent = procedure (Sender: TLanauthThread; AMessage: String) of object;

  TLanauthThread = class(TThread)
  private
      FState: Integer;
      FSocket: TSocket;
      FEvent : THandle;
    FResultCode: Integer;
    FOp: String;
    FSocketError: Integer;
    FExceptionMessage: String;
    FPrintMessage: String;
      FOnStateChange: TLanauthNotifyEvent;
      FOnSocketChange: TLanauthSocketEvent;
      FOnSocketError: TLanauthErrorEvent;
      FOnException: TLanauthExceptionEvent;
      FOnPrint: TLanauthPrintEvent;
    FOnBeginAuth: TLanauthNotifyEvent;
    FOnEndAuth: TLanauthNotifyEvent;
    FPass: String;
    FGateip: Array[0..15] of Byte;
    FChallenge: Array[0..255] of Byte;
    FDigest: Array[0..255] of Byte;
    function GetConnected: Boolean;
    function SocketCheck(ResultCode: Integer; const Op: string): Integer;
    procedure DoStateChange;
        procedure DoSocketChange;
        procedure DoSocketError;
        procedure DoException;
        procedure DoPrint;
        procedure DoBeginAuth;
        procedure DoEndAuth;
    procedure Print(AMessage: String);
        procedure SetState(AState: Integer);
        procedure SetException(AException: Exception);
        function CheckNetwork: Boolean;
        function waitrecv(const s: Cardinal; timeinterval: Integer): Integer;
        function recv2(const s: Cardinal; var Buf; len: Integer; flags: Integer): Integer;
        procedure ServerConnect;
        procedure ServerDisconnect;
        procedure Auth2;
  protected
    procedure Execute; override;
  public
      property Connected: Boolean read GetConnected;
      property State: Integer read FState;
      property OnStateChange: TLanauthNotifyEvent read FOnStateChange write FOnStateChange;
      property OnSocketChange: TLanauthSocketEvent read FOnSocketChange write FOnSocketChange;
      property OnSocketError: TLanauthErrorEvent read FOnSocketError write FOnSocketError;
      property OnException: TLanauthExceptionEvent read FOnException write FOnException;
      property OnPrint: TLanauthPrintEvent read FOnPrint write FOnPrint;
    property OnBeginAuth: TLanauthNotifyEvent read FOnBeginAuth write FOnBeginAuth;
    property OnEndAuth: TLanauthNotifyEvent read FOnEndAuth write FOnEndAuth;
  end;

implementation

procedure Startup;
var
    wsaData: TWSAData;
  errorCode: Integer;
begin
  errorCode := WSAStartup(WINSOCK_VERSION, WSAData);
  if errorCode <> 0 then
    raise ESocketError.CreateResFmt(@sWindowsSocketError,
      [SysErrorMessage(errorCode), errorCode, 'WSAStartup']);
end;

procedure Cleanup;
var
  errorCode: Integer;
begin
  errorCode := WSACleanup;
  if errorCode <> 0 then
    raise ESocketError.CreateResFmt(@sWindowsSocketError,
      [SysErrorMessage(errorCode), errorCode, 'WSACleanup']);
end;

{ TLanauthThread }

function TLanauthThread.SocketCheck(ResultCode: Integer; const Op: string): Integer;
begin
    FResultCode := ResultCode;
  FOp := Op;
    Synchronize(DoSocketChange);
    FSocketError := 0;
  if ResultCode <> 0 then
  begin
      if (CText(Op, 'recv') or CText(Op, 'send')) and (ResultCode > 0) then
        Result := 0
    else
      if CText(Op, 'socket') and (ResultCode <> INVALID_SOCKET) then
          Result := ResultCode
    else
      if CText(Op, 'WSACreateEvent') and (ResultCode <> WSA_INVALID_EVENT) then
          Result := ResultCode
    else
    begin
      Result := WSAGetLastError;
      if Result = 0 then
          Abort
      else
      begin
        FSocketError := Result;
        Synchronize(DoSocketError);
        if Result <> WSAEWOULDBLOCK then
          raise ESocketError.CreateResFmt(@sWindowsSocketError,
            [SysErrorMessage(Result), Result, Op]);
      end;
    end;
  end
  else
      Result := 0;
end;

procedure TLanauthThread.DoStateChange;
begin
    if Assigned(FOnStateChange) then
      try
          FOnStateChange(Self);
    except
    end;
end;

procedure TLanauthThread.DoSocketChange;
begin
    if Assigned(FOnSocketChange) then
      try
          FOnSocketChange(Self, FResultCode, FOp);
    except
    end;
end;

procedure TLanauthThread.DoSocketError;
begin
    if Assigned(FOnSocketError) then
      try
          FOnSocketError(Self, FSocketError);
    except
    end;
end;

procedure TLanauthThread.DoException;
begin
    if Assigned(FOnException) then
      try
          FOnException(Self, FExceptionMessage);
    except
    end;
end;

procedure TLanauthThread.DoPrint;
begin
    if Assigned(FOnPrint) then
      try
          FOnPrint(Self, FPrintMessage);
    except
    end;
end;

procedure TLanauthThread.DoBeginAuth;
begin
    if Assigned(FOnBeginAuth) then
      try
          FOnBeginAuth(Self);
    except
    end;
end;

procedure TLanauthThread.DoEndAuth;
begin
    if Assigned(FOnEndAuth) then
      try
          FOnEndAuth(Self);
    except
    end;
end;

procedure TLanauthThread.Print(AMessage: String);
begin
  FPrintMessage := AMessage;
  Synchronize(DoPrint);
end;

procedure TLanauthThread.SetState(AState: Integer);
begin
    if FState <> AState then
  begin
    FState := AState;
        Synchronize(DoStateChange);
  end;
end;

procedure TLanauthThread.SetException(AException: Exception);
begin
    if AException <> nil then
  begin
    FExceptionMessage := AException.ClassName + ': ' + AException.Message;
        Synchronize(DoException);
  end;
end;

procedure TLanauthThread.Auth2;
var
  mdctx: EVP_MD_CTX;
  md_len, i: Cardinal;
begin
    for i := 0 to 255-1 do
      FDigest[i] := Random(MAXINT) mod 256;
    FDigest[0] := ACCESS_LEVEL - 1;
    FDigest[1] := 2 + Random(MAXINT) mod 230;

  try
    OpenSSL_add_all_digests();
    EVP_DigestInit(@mdctx, EVP_ripemd160());
    EVP_DigestUpdate(@mdctx, Pointer(Integer(@FChallenge)+1), FChallenge[0]);
    EVP_DigestUpdate(@mdctx, @FPass[1], Length(FPass));
    EVP_DigestFinal(@mdctx, Pointer(Integer(@FDigest)+FDigest[1]), md_len);
  finally
    EVP_Cleanup;
  end;
end;

function TLanauthThread.CheckNetwork: Boolean;
var
    NetworkEvents: TWSANetworkEvents;
begin
    Result := True;
  WaitForSingleObject(FEvent, 500);
  WSAEnumNetworkEvents(FSocket, FEvent, @NetworkEvents);
  if NetworkEvents.lNetworkEvents and FD_Close > 0 then
  begin
        Result := False;
    if NetworkEvents.iErrorCode[FD_Close_Bit] = 0 then
    begin
        Print('Связь закрыта корректно');
    end
    else
    begin
        Print('Связь разорвана в результате сбоя сети: ' + IntToStr(NetworkEvents.iErrorCode[FD_Close_Bit]));
    end;
  end;
  WSAResetEvent(FEvent);
end;

function TLanauthThread.waitrecv(const s: Cardinal; timeinterval: Integer): Integer;
var
    lastTick: Cardinal;
  bytescount: Cardinal;
  {setW, setE: TFDSet;
  time: TTimeVal;}
  buf: Byte;
begin
    Result := 0;
  {time.tv_sec := 0;
  time.tv_usec := 100;}
  buf := 0;
    lastTick := GetTickCount;
  while not Terminated and (GetTickCount - lastTick < timeinterval) and CheckNetwork do
  begin
    Print(Format('waitrecv: tick %d', [GetTickCount - lastTick]));

    {FD_Zero(setW);
    FD_Set(FSocket, setW);
    FD_Zero(setE);
    FD_Set(FSocket, setE);
    Print(Format('select: %d', [select(0, nil, @setW, @setE, @time)]));
    Print(Format('  setW: %s, setE: %s', [Str(FD_IsSet(FSocket, setW)), Str(FD_IsSet(FSocket, setE))]));}

    {
    if send(FSocket, buf, 1, 0) <> 1 then
    begin
          Result := -1;
    end;
    }
    {
    Print('Проверка наличия связи...');
    try
        SocketCheck(send(FSocket, buf, 1, 0), 'send');
    except
    end;
    }

    Result := ioctlsocket(FSocket, FIONREAD, bytescount);
      if Result = SOCKET_ERROR then Exit;
    if bytescount > 0 then Exit;

    Sleep(500);
  end;
    Result := -1;
end;

function TLanauthThread.recv2(const s: Cardinal; var Buf; len: Integer; flags: Integer): Integer;
var
    lastTick: Cardinal;
  error: Integer;
  bytescount: Cardinal;
begin
    Result := 0;
    lastTick := GetTickCount;
  while not Terminated and (GetTickCount - lastTick < MAX_RECEIVE_INTERVAL) do
  begin
    //Print(Format('ioctlsocket: tick %d', [GetTickCount - lastTick]));
    Result := ioctlsocket(FSocket, FIONREAD, bytescount);
      if Result = SOCKET_ERROR then Exit;
    if bytescount > 0 then
      begin
      Print(Format('recv2: len %d', [len]));
      Result := recv(s, Buf, len, flags);
      Print(Format('  recv2: Result %d', [Result]));
      if (Result < 0) then
        Print(Format('  recv2: Error %d', [WSAGetLastError]));
      if (Result >= 0) then
        Exit
      else
      begin
        error := WSAGetLastError;
        if (error <> 0) and (error <> WSAETIMEDOUT) then
          Exit;
      end;
    end;
    Sleep(500);
  end;
    Result := -1;
end;

procedure TLanauthThread.ServerConnect;
var
    connectInterval: Cardinal;
  connectTime: Cardinal;
  connectCount, connectMaxCount: Cardinal;
  lastTick: Cardinal;
    adr: TSockAddr;
    buf: Byte;
begin
    if Connected then Exit;

  Print('init connect');
  FSocket := SocketCheck(socket(AF_INET, SOCK_STREAM, IPPROTO_TCP), 'socket');
  FEvent := SocketCheck(WSACreateEvent, 'WSACreateEvent');
  //SocketCheck(WSAEventSelect(FSocket, FEvent, FD_CLOSE), 'WSAEventSelect');
  adr.sin_family := PF_Inet;
  adr.sin_addr.S_addr := inet_addr(SERVER_ADDRESS);
  adr.sin_port := HtoNS(SERVER_PORT);
  FillChar(adr.sin_zero, SizeOf(adr.sin_zero), 0);
  connectCount := 0;
  connectInterval := MIN_CONNECT_INTERVAL;
  connectTime := GetTickCount;
  lastTick := 0;

  while not Terminated do
  begin

    try

        if GetTickCount - lastTick > connectInterval then
      begin
        lastTick := GetTickCount;

        SetState(0);
        Inc(connectCount);
        if connectCount > MAX_CONNECT_COUNT then
        begin
          connectCount := 0;
          connectInterval := connectInterval * 2;
          if GetTickCount - connectTime > CONNECT_PERIOD then
          begin
            connectTime := GetTickCount;
            connectInterval := MIN_CONNECT_INTERVAL;
            Synchronize(DoStateChange);
          end;
          Continue;
        end;

                Print(Format('connect to server %s...', [inet_ntoa(adr.sin_addr)]));
        SocketCheck(connect(FSocket, @adr, SizeOf(TSockAddr)), 'connect');

                Print('receive answer...');
        buf := 0;
        SocketCheck(recv2(FSocket, buf, 1, 0) , 'recv');
        Print(Format('answer is %d', [buf]));
        case buf of
          0: SetState(-1); // access closed
          1: SetState(0); // continue authorization
          2: begin // redirect to real server
              SetState(0);
            {read(sock, &ch, 1);
            if(ch < 7 || ch > 15)
            fatal("redirect: invalid gateway lenght %d", ch);
            read(sock, gateip, ch);
            gateip[ch] = 0;
            syslog(LOG_NOTICE, "gate changed to %s", gateip);
            close(sock);
            break;}
          end
          else begin
              SetState(0);
            {close(sock);
            syslog(LOG_NOTICE, "unknown protocol %d", ch);
            sleep(60);
            break;}
          end;
        end;
        if buf = 1 then
        begin
        Print('connect done.');
            Break;
        end;

      end;
      Sleep(100);

    except
      on e: exception do
        SetException(e);
    end;

  end;
end;

procedure TLanauthThread.ServerDisconnect;
begin
    if not Connected then Exit;
    Print('disconnect from server...');
  WSACloseEvent(FEvent);
  shutdown(FSocket, SD_BOTH);
  closesocket(FSocket);
  FSocket := 0;
  SetState(0);
end;

function TLanauthThread.GetConnected: Boolean;
begin
    Result := (FSocket > 0);
end;

procedure TLanauthThread.Execute;
var
  lastTick: Cardinal;
    buf: Byte;
  i: Integer;
begin
    Print('init execute...');
    FExceptionMessage := '';
  FResultCode := 0;
  FOp := '';
  FSocketError := 0;
    Randomize;
  FPass := 'Пароль кабинет';

    FSocket := 0;
  Startup;
  try
    lastTick := 0;
        while not Terminated do
        begin


           try

    if GetTickCount - lastTick > AUTH_INTERVAL then

    begin

              
        lastTick := GetTickCount;
              
        Synchronize(DoBeginAuth);


        ServerConnect;

                            
        Print('wait for challenge...');
              
        SocketCheck(waitrecv(FSocket, CHALLENGE_INTERVAL) , 'waitrecv');


        Print('receive challenge...');
          
        SocketCheck(recv2(FSocket, FChallenge, SizeOf(FChallenge), 0) , 'recv');


        Print('auth challenge...');
              
        Auth2();

        Print('send digest...');
              
        SocketCheck(send(FSocket, FDigest, SizeOf(FDigest), 0) , 'send');

        Print('receive state...');
              
        buf := 0;
              
        SocketCheck(recv2(FSocket, buf, 1, 0) , 'recv');
                    
        Print(Format('answer is %d', [buf]));

              
        SetState(buf);
              
        Synchronize(DoEndAuth);

            
        end;
                  
        Sleep(100);

          
    except
            
        on e: exception do
        begin
        SetException(e);
        ServerDisconnect;
            end;
          end;
        end;

  
  finally
    ServerDisconnect;
    Cleanup;
  end;
end;

end.


libeay32, WinSock2 ищем в инете. Трейс можно убрать вообще.

Есть некоторый глюк проявляющийся через месяца работы, приходится пере стартовать задачу.
Вернуться в начало страницы
 
+Ответить с цитированием данного сообщения
slivafra
сообщение 4.11.2010, 08:35
Сообщение #4





Группа: Пользователи
Регистрация: 2.9.2010
Пользователь №: 50 743



Вопрос простой: чем компилировать?
Вернуться в начало страницы
 
+Ответить с цитированием данного сообщения
Yuken
сообщение 4.11.2010, 23:09
Сообщение #5





Группа: Пользователи
Регистрация: 17.4.2006
Пользователь №: 11 012



slivafra, Delphi, не?
Вернуться в начало страницы
 
+Ответить с цитированием данного сообщения
GR@F
сообщение 29.8.2011, 23:16
Сообщение #6





Группа: Пользователи
Регистрация: 6.7.2007
Пользователь №: 25 995



может до компонента доделаете? чтоб кинуть на форму и не маяться happy.gif
Вернуться в начало страницы
 
+Ответить с цитированием данного сообщения
Next
сообщение 30.8.2011, 08:28
Сообщение #7





Группа: Пользователи
Регистрация: 28.8.2003
Пользователь №: 9



srvany не вариант?
Вернуться в начало страницы
 
+Ответить с цитированием данного сообщения

Ответить в эту темуОткрыть новую тему
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 



- Текстовая версия Сейчас: 20.1.2018, 19:54
Блог КАБiNET