Experimental support for LibSSH2 by ssl_libssh2.pas plugin. (Alexey Suhinin)
git-svn-id: https://svn.code.sf.net/p/synalist/code/trunk@177 7c85be65-684b-0410-a082-b2ed4fbef004
This commit is contained in:
geby
parent
e76062c638
commit
f14a216cfd
245
ssl_libssh2.pas
Normal file
245
ssl_libssh2.pas
Normal file
@ -0,0 +1,245 @@
|
||||
{==============================================================================|
|
||||
| Project : Ararat Synapse | 001.000.000 |
|
||||
|==============================================================================|
|
||||
| Content: SSH support by LibSSH2 |
|
||||
|==============================================================================|
|
||||
| Copyright (c)1999-2013, Lukas Gebauer |
|
||||
| All rights reserved. |
|
||||
| |
|
||||
| Redistribution and use in source and binary forms, with or without |
|
||||
| modification, are permitted provided that the following conditions are met: |
|
||||
| |
|
||||
| Redistributions of source code must retain the above copyright notice, this |
|
||||
| list of conditions and the following disclaimer. |
|
||||
| |
|
||||
| Redistributions in binary form must reproduce the above copyright notice, |
|
||||
| this list of conditions and the following disclaimer in the documentation |
|
||||
| and/or other materials provided with the distribution. |
|
||||
| |
|
||||
| Neither the name of Lukas Gebauer nor the names of its contributors may |
|
||||
| be used to endorse or promote products derived from this software without |
|
||||
| specific prior written permission. |
|
||||
| |
|
||||
| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
|
||||
| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
|
||||
| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
|
||||
| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR |
|
||||
| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
|
||||
| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR |
|
||||
| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER |
|
||||
| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
|
||||
| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
|
||||
| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH |
|
||||
| DAMAGE. |
|
||||
|==============================================================================|
|
||||
| The Initial Developer of the Original Code is Alexey Suhinin. |
|
||||
| Portions created by Alexey Suhinin are Copyright (c)2012-2013. |
|
||||
| Portions created by Lukas Gebauer are Copyright (c)2013-2013. |
|
||||
| All Rights Reserved. |
|
||||
|==============================================================================|
|
||||
| Contributor(s): |
|
||||
|==============================================================================|
|
||||
| History: see HISTORY.HTM from distribution package |
|
||||
| (Found at URL: http://www.ararat.cz/synapse/) |
|
||||
|==============================================================================}
|
||||
|
||||
//requires LibSSH2 libraries! http://libssh2.org
|
||||
|
||||
{:@abstract(SSH plugin for LibSSH2)
|
||||
|
||||
Require libssh2.dll or libssh2.so. You can download binaries it as part
|
||||
of CURL project from http://curl.haxx.se/download.html
|
||||
|
||||
You need pascal bindongs for library too! You can found one at:
|
||||
http://www.lazarus.freepascal.org/index.php/topic,15935.msg86465.html#msg86465
|
||||
|
||||
This plugin implementing client part only.
|
||||
}
|
||||
|
||||
{$IFDEF FPC}
|
||||
{$MODE DELPHI}
|
||||
{$ENDIF}
|
||||
{$H+}
|
||||
|
||||
unit ssl_libssh2;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils,
|
||||
blcksock, synsock,
|
||||
libssh2;
|
||||
|
||||
type
|
||||
{:@abstract(class implementing LibSSH2 SSH plugin.)
|
||||
Instance of this class will be created for each @link(TTCPBlockSocket).
|
||||
You not need to create instance of this class, all is done by Synapse itself!}
|
||||
TSSLLibSSH2 = class(TCustomSSL)
|
||||
protected
|
||||
FSession: PLIBSSH2_SESSION;
|
||||
FChannel: PLIBSSH2_CHANNEL;
|
||||
function SSHCheck(Value: integer): Boolean;
|
||||
function DeInit: Boolean;
|
||||
public
|
||||
{:See @inherited}
|
||||
constructor Create(const Value: TTCPBlockSocket); override;
|
||||
destructor Destroy; override;
|
||||
{:See @inherited}
|
||||
function LibVersion: String; override;
|
||||
{:See @inherited}
|
||||
function LibName: String; override;
|
||||
{:See @inherited}
|
||||
function Connect: boolean; override;
|
||||
{:See @inherited}
|
||||
function Shutdown: boolean; override;
|
||||
{:See @inherited}
|
||||
function BiShutdown: boolean; override;
|
||||
{:See @inherited}
|
||||
function SendBuffer(Buffer: TMemory; Len: Integer): Integer; override;
|
||||
{:See @inherited}
|
||||
function RecvBuffer(Buffer: TMemory; Len: Integer): Integer; override;
|
||||
{:See @inherited}
|
||||
function WaitingData: Integer; override;
|
||||
{:See @inherited}
|
||||
function GetSSLVersion: string; override;
|
||||
published
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{==============================================================================}
|
||||
function TSSLLibSSH2.SSHCheck(Value: integer): Boolean;
|
||||
var
|
||||
PLastError: PAnsiChar;
|
||||
ErrMsgLen: Integer;
|
||||
begin
|
||||
Result := true;
|
||||
FLastError := 0;
|
||||
FLastErrorDesc := '';
|
||||
if Value<0 then
|
||||
begin
|
||||
FLastError := libssh2_session_last_error(FSession, PLastError, ErrMsglen, 0);
|
||||
FLastErrorDesc := PLastError;
|
||||
Result := false;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
function TSSLLibSSH2.DeInit: Boolean;
|
||||
begin
|
||||
if Assigned(FChannel) then
|
||||
begin
|
||||
libssh2_channel_free(FChannel);
|
||||
FChannel := nil;
|
||||
end;
|
||||
if Assigned(FSession) then
|
||||
begin
|
||||
libssh2_session_disconnect(FSession,'Goodbye');
|
||||
libssh2_session_free(FSession);
|
||||
FSession := nil;
|
||||
end;
|
||||
FSSLEnabled := False;
|
||||
Result := true;
|
||||
end;
|
||||
|
||||
constructor TSSLLibSSH2.Create(const Value: TTCPBlockSocket);
|
||||
begin
|
||||
inherited Create(Value);
|
||||
FSession := nil;
|
||||
FChannel := nil;
|
||||
end;
|
||||
|
||||
destructor TSSLLibSSH2.Destroy;
|
||||
begin
|
||||
DeInit;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TSSLLibSSH2.Connect: boolean;
|
||||
begin
|
||||
Result := False;
|
||||
if SSLEnabled then DeInit;
|
||||
if (FSocket.Socket <> INVALID_SOCKET) and (FSocket.SSL.SSLType = LT_SSHv2) then
|
||||
begin
|
||||
FSession := libssh2_session_init();
|
||||
if not Assigned(FSession) then
|
||||
begin
|
||||
FLastError := -999;
|
||||
FLastErrorDesc := 'Cannot initialize SSH session';
|
||||
exit;
|
||||
end;
|
||||
if not SSHCheck(libssh2_session_startup(FSession, FSocket.Socket)) then
|
||||
exit;
|
||||
if FSocket.SSL.PrivateKeyFile<>'' then
|
||||
if (not SSHCheck(libssh2_userauth_publickey_fromfile(FSession, PChar(FSocket.SSL.Username), nil, PChar(FSocket.SSL.PrivateKeyFile), PChar(FSocket.SSL.KeyPassword))))
|
||||
and (not SSHCheck(libssh2_userauth_password(FSession, PChar(FSocket.SSL.Username), PChar(FSocket.SSL.Password)))) then
|
||||
exit;
|
||||
FChannel := libssh2_channel_open_session(FSession);
|
||||
if not assigned(FChannel) then
|
||||
begin
|
||||
// SSHCheck(-1);
|
||||
FLastError:=-999;
|
||||
FLastErrorDesc := 'Cannot open session';
|
||||
exit;
|
||||
end;
|
||||
if not SSHCheck(libssh2_channel_request_pty(FChannel, 'vanilla')) then
|
||||
exit;
|
||||
if not SSHCheck(libssh2_channel_shell(FChannel)) then
|
||||
exit;
|
||||
FSSLEnabled := True;
|
||||
Result := True;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TSSLLibSSH2.LibName: String;
|
||||
begin
|
||||
Result := 'ssl_libssh2';
|
||||
end;
|
||||
|
||||
function TSSLLibSSH2.Shutdown: boolean;
|
||||
begin
|
||||
Result := DeInit;
|
||||
end;
|
||||
|
||||
|
||||
function TSSLLibSSH2.BiShutdown: boolean;
|
||||
begin
|
||||
Result := DeInit;
|
||||
end;
|
||||
|
||||
function TSSLLibSSH2.SendBuffer(Buffer: TMemory; Len: Integer): Integer;
|
||||
begin
|
||||
Result:=libssh2_channel_write(FChannel, PAnsiChar(Buffer), Len);
|
||||
SSHCheck(Result);
|
||||
end;
|
||||
|
||||
function TSSLLibSSH2.RecvBuffer(Buffer: TMemory; Len: Integer): Integer;
|
||||
begin
|
||||
result:=libssh2_channel_read(FChannel, PAnsiChar(Buffer), Len);
|
||||
SSHCheck(Result);
|
||||
end;
|
||||
|
||||
function TSSLLibSSH2.WaitingData: Integer;
|
||||
begin
|
||||
if libssh2_poll_channel_read(FChannel, Result) <> 1 then
|
||||
Result := 0;
|
||||
end;
|
||||
|
||||
function TSSLLibSSH2.GetSSLVersion: string;
|
||||
begin
|
||||
Result := 'SSH2';
|
||||
end;
|
||||
|
||||
function TSSLLibSSH2.LibVersion: String;
|
||||
begin
|
||||
Result := libssh2_version(0);
|
||||
end;
|
||||
|
||||
initialization
|
||||
if libssh2_init(0)=0 then
|
||||
SSLImplementation := TSSLLibSSH2;
|
||||
|
||||
finalization
|
||||
libssh2_exit;
|
||||
|
||||
end.
|
||||
Loading…
x
Reference in New Issue
Block a user