doublecmd/plugins/wfx/samba/src/smbfunc.pas
2016-06-13 18:00:18 +00:00

580 lines
17 KiB
ObjectPascal

{
Double commander
-------------------------------------------------------------------------
WFX plugin for working with Common Internet File System (CIFS)
Copyright (C) 2011-2015 Alexander Koblov (alexx2000@mail.ru)
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or (at your option) any later version.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
}
unit SmbFunc;
{$mode objfpc}{$H+}
interface
uses
InitC, Classes, SysUtils, WfxPlugin, Extension;
function FsInit(PluginNr: Integer; pProgressProc: TProgressProc; pLogProc: TLogProc; pRequestProc: TRequestProc): Integer; cdecl;
function FsFindFirst(Path: PAnsiChar; var FindData: TWin32FindData): THandle; cdecl;
function FsFindNext(Hdl: THandle; var FindData: TWin32FindData): BOOL; cdecl;
function FsFindClose(Hdl: THandle): Integer; cdecl;
function FsRenMovFile(OldName, NewName: PAnsiChar; Move, OverWrite: BOOL;
RemoteInfo: pRemoteInfo): Integer; cdecl;
function FsGetFile(RemoteName, LocalName: PAnsiChar; CopyFlags: Integer;
RemoteInfo: pRemoteInfo): Integer; cdecl;
function FsPutFile(LocalName, RemoteName: PAnsiChar; CopyFlags: Integer): Integer; cdecl;
function FsDeleteFile(RemoteName: PAnsiChar): BOOL; cdecl;
function FsMkDir(RemoteDir: PAnsiChar): BOOL; cdecl;
function FsRemoveDir(RemoteName: PAnsiChar): BOOL; cdecl;
function FsSetAttr(RemoteName: PAnsiChar; NewAttr: Integer): BOOL; cdecl;
function FsSetTime(RemoteName: PAnsiChar; CreationTime, LastAccessTime, LastWriteTime: PFileTime): BOOL; cdecl;
procedure FsGetDefRootName(DefRootName: PAnsiChar; MaxLen: Integer); cdecl;
{ Extension API }
procedure ExtensionInitialize(StartupInfo: PExtensionStartupInfo); cdecl;
var
Message: AnsiString;
WorkGroup: array[0..MAX_PATH-1] of AnsiChar;
UserName: array[0..MAX_PATH-1] of AnsiChar;
Password: array[0..MAX_PATH-1] of AnsiChar;
ExtensionStartupInfo: TExtensionStartupInfo;
implementation
uses
Math, Unix, BaseUnix, UnixType, StrUtils, URIParser, SmbAuthDlg, libsmbclient;
const
SMB_BUFFER_SIZE = 524288;
type
PSambaHandle = ^TSambaHandle;
TSambaHandle = record
Path: String;
Handle: LongInt;
end;
var
ProgressProc: TProgressProc;
LogProc: TLogProc;
RequestProc: TRequestProc;
PluginNumber: Integer;
Auth: Boolean = False;
Abort: Boolean = False;
NeedAuth: Boolean = False;
function FileTimeToUnixTime(ft: TFileTime): time_t;
var
UnixTime: Int64;
begin
UnixTime:= ft.dwHighDateTime;
UnixTime:= (UnixTime shl 32) or ft.dwLowDateTime;
UnixTime:= (UnixTime - 116444736000000000) div 10000000;
Result:= time_t(UnixTime);
end;
function UnixTimeToFileTime(mtime: time_t): TFileTime;
var
FileTime: Int64;
begin
FileTime:= Int64(mtime) * 10000000 + 116444736000000000;
Result.dwLowDateTime:= (FileTime and $FFFF);
Result.dwHighDateTime:= (FileTime shr $20);
end;
function URIEncode(Path: String): String;
begin
Result:= FileNameToURI(Path);
Result:= 'smb:/' + Copy(Result, 8, MaxInt);
end;
procedure WriteError(const FuncName: String);
begin
WriteLn(FuncName + ': ', SysErrorMessage(fpgetCerrno));
end;
procedure smbc_get_auth_data(server, share: PAnsiChar;
wg: PAnsiChar; wglen: LongInt;
un: PAnsiChar; unlen: LongInt;
pw: PAnsiChar; pwlen: LongInt); cdecl;
begin
Auth:= True;
if NeedAuth then
begin
Abort:= True;
// Set query resource
if (server = nil) then
Message:= StrPas(share)
else
Message:= StrPas(server) + PathDelim + StrPas(share);
// Set authentication data
StrLCopy(WorkGroup, wg, wglen);
StrLCopy(UserName, un, unlen);
StrLCopy(Password, pw, pwlen);
// Query authentication data
if ShowSmbAuthDlg then
begin
Abort:= False;
// Get authentication data
StrLCopy(wg, WorkGroup, wglen);
StrLCopy(un, UserName, unlen);
StrLCopy(pw, Password, pwlen);
end;
end
else
begin
// If has saved workgroup then use it
if StrLen(WorkGroup) <> 0 then
StrLCopy(wg, WorkGroup, wglen);
// If has saved user name then use it
if StrLen(UserName) <> 0 then
StrLCopy(un, UserName, unlen);
// If has saved password then use it
if StrLen(Password) <> 0 then
StrLCopy(pw, Password, pwlen);
end;
end;
function BuildNetworkPath(const Path: String): String;
var
I, C: Integer;
begin
C:= 0;
if Path = PathDelim then Exit('smb://');
Result := Path;
// Don't check last symbol
for I := 1 to Length(Result) - 1 do
begin
if (Result[I] = PathDelim) then
Inc(C);
end;
if (C < 2) then
Result:= URIEncode(Result)
else
begin
I:= PosEx(PathDelim, Result, 2);
Result:= URIEncode(Copy(Result, I, MaxInt));
end;
end;
function ForceAuth(Path: PAnsiChar): String;
var
un: array[0..MAX_PATH-1] of AnsiChar;
pw: array[0..MAX_PATH-1] of AnsiChar;
begin
Result:= BuildNetworkPath(Path);
// Use by default saved user name and password
StrLCopy(un, UserName, MAX_PATH);
StrLCopy(pw, Password, MAX_PATH);
// Query auth data
smbc_get_auth_data(nil, PAnsiChar(Result), WorkGroup, MAX_PATH, un, MAX_PATH, pw, MAX_PATH);
if (Abort = False) and (un <> '') then
begin
if StrLen(WorkGroup) = 0 then
Result:= 'smb://' + un + ':' + pw + '@' + Copy(Result, 7, MAX_PATH)
else
Result:= 'smb://' + WorkGroup + ';' + un + ':' + pw + '@' + Copy(Result, 7, MAX_PATH);
end;
end;
function FsInit(PluginNr: Integer; pProgressProc: tProgressProc; pLogProc: tLogProc; pRequestProc: tRequestProc): Integer; cdecl;
begin
if not LoadSambaLibrary then
begin
pRequestProc(PluginNr, RT_MsgOK, nil, 'Can not load "libsmbclient" library!', nil, 0);
Exit(-1);
end;
ProgressProc := pProgressProc;
LogProc := pLogProc;
RequestProc := pRequestProc;
PluginNumber := PluginNr;
FillChar(WorkGroup, SizeOf(WorkGroup), #0);
FillChar(UserName, SizeOf(UserName), #0);
FillChar(Password, SizeOf(Password), #0);
Result := smbc_init(@smbc_get_auth_data, 0);
if Result < 0 then WriteError('smbc_init');
end;
function FsFindFirst(Path: PAnsiChar; var FindData: TWin32FindData): THandle; cdecl;
var
NetworkPath: String;
SambaHandle: PSambaHandle;
Handle: LongInt;
begin
Abort:= False;
NetworkPath:= BuildNetworkPath(Path);
repeat
Auth:= False;
Handle:= smbc_opendir(PChar(NetworkPath));
NeedAuth:= (Handle = -1);
// Sometimes smbc_get_auth_data don't called automatically
// so we call it manually
if NeedAuth and (Auth = False) then
begin
NetworkPath:= ForceAuth(Path);
end;
until not NeedAuth or Abort;
if Handle < 0 then
begin
WriteError('smbc_opendir');
Result:= wfxInvalidHandle;
end
else
begin
New(SambaHandle);
SambaHandle^.Path:= IncludeTrailingPathDelimiter(NetworkPath);
SambaHandle^.Handle:= Handle;
Result:= THandle(SambaHandle);
FsFindNext(Result, FindData);
end;
end;
function FsFindNext(Hdl: THandle; var FindData: TWin32FindData): BOOL; cdecl;
var
dirent: psmbc_dirent;
FileInfo: BaseUnix.Stat;
Mode: array[0..10] of AnsiChar;
SambaHandle: PSambaHandle absolute Hdl;
begin
Result:= True;
dirent := smbc_readdir(SambaHandle^.Handle);
if (dirent = nil) then Exit(False);
FillByte(FindData, SizeOf(TWin32FindData), 0);
StrLCopy(FindData.cFileName, dirent^.name, dirent^.namelen);
if dirent^.smbc_type in [SMBC_WORKGROUP, SMBC_SERVER, SMBC_FILE_SHARE] then
FindData.dwFileAttributes:= FILE_ATTRIBUTE_DIRECTORY;
if dirent^.smbc_type in [SMBC_DIR, SMBC_FILE, SMBC_LINK] then
begin
if smbc_stat(PChar(SambaHandle^.Path + FindData.cFileName), @FileInfo) = 0 then
begin
FindData.nFileSizeLow := (FileInfo.st_size and MAXDWORD);
FindData.nFileSizeHigh := (FileInfo.st_size shr $20);
FindData.ftLastAccessTime:= UnixTimeToFileTime(FileInfo.st_atime);
FindData.ftCreationTime:= UnixTimeToFileTime(FileInfo.st_ctime);
FindData.ftLastWriteTime:= UnixTimeToFileTime(FileInfo.st_mtime);
FindData.dwFileAttributes:= IfThen(fpS_ISDIR(FileInfo.st_mode), FILE_ATTRIBUTE_DIRECTORY, 0);
end;
if smbc_getxattr(PChar(SambaHandle^.Path + FindData.cFileName), 'system.dos_attr.mode', @Mode, SizeOf(Mode)) >= 0 then
begin
// smbc_getxattr returns attributes as hex string (like 0x00000000)
FindData.dwFileAttributes:= StrToIntDef(Mode, FindData.dwFileAttributes);
end;
end;
end;
function FsFindClose(Hdl: THandle): Integer; cdecl;
var
SambaHandle: PSambaHandle absolute Hdl;
begin
Result:= smbc_closedir(SambaHandle^.Handle);
if Result < 0 then WriteError('smbc_closedir');
Dispose(SambaHandle);
end;
function FsRenMovFile(OldName, NewName: PAnsiChar; Move, OverWrite: BOOL;
RemoteInfo: pRemoteInfo): Integer; cdecl;
var
OldFileName,
NewFileName: String;
Buffer: Pointer = nil;
BufferSize: LongWord;
fdOldFile: LongInt;
fdNewFile: LongInt;
dwRead: ssize_t;
Written: Int64;
FileSize: Int64;
Percent: LongInt;
Flags: cint = O_CREAT or O_RDWR or O_TRUNC;
begin
OldFileName:= BuildNetworkPath(OldName);
NewFileName:= BuildNetworkPath(NewName);
if Move then
begin
if smbc_rename(PChar(OldFileName), PChar(NewFileName)) < 0 then
Exit(-1);
end
else
begin
if OverWrite = False then
begin
Flags:= Flags or O_EXCL;
end;
BufferSize:= SMB_BUFFER_SIZE;
Buffer:= GetMem(BufferSize);
try
// Open source file
fdOldFile:= smbc_open(PChar(OldFileName), O_RDONLY, 0);
if (fdOldFile < 0) then Exit(FS_FILE_READERROR);
// Open target file
fdNewFile:= smbc_open(PChar(NewFileName), Flags, RemoteInfo^.Attr);
if (fdNewFile < 0) then
begin
if cerrno = ESysEEXIST then
Exit(FS_FILE_EXISTS)
else
Exit(FS_FILE_WRITEERROR);
end;
// Get source file size
FileSize:= smbc_lseek(fdOldFile, 0, SEEK_END);
smbc_lseek(fdOldFile, 0, SEEK_SET);
Written:= 0;
// Copy data
repeat
dwRead:= smbc_read(fdOldFile, Buffer, BufferSize);
if (dwRead < 0) then Exit(FS_FILE_READERROR);
if (dwRead > 0) then
begin
if smbc_write(fdNewFile, Buffer, dwRead) <> dwRead then
Exit(FS_FILE_WRITEERROR);
Written:= Written + dwRead;
// Calculate percent
Percent:= (Written * 100) div FileSize;
// Update statistics
if ProgressProc(PluginNumber, PChar(OldFileName), PChar(NewFileName), Percent) = 1 then
Exit(FS_FILE_USERABORT);
end;
until (dwRead = 0);
finally
if Assigned(Buffer) then
FreeMem(Buffer);
if not (fdOldFile < 0) then
smbc_close(fdOldFile);
if not (fdNewFile < 0) then
smbc_close(fdNewFile);
end;
end;
Result:= FS_FILE_OK;
end;
function FsGetFile(RemoteName, LocalName: PAnsiChar; CopyFlags: Integer;
RemoteInfo: pRemoteInfo): Integer; cdecl;
var
OldFileName: String;
Buffer: Pointer = nil;
BufferSize: LongWord;
fdOldFile: LongInt;
fdNewFile: LongInt;
dwRead: ssize_t;
Written: Int64;
FileSize: Int64;
Percent: LongInt;
Flags: cint = O_CREAT or O_RDWR or O_TRUNC;
begin
OldFileName:= BuildNetworkPath(RemoteName);
if (CopyFlags and FS_COPYFLAGS_OVERWRITE) = 0 then
begin
Flags:= Flags or O_EXCL;
end;
BufferSize:= SMB_BUFFER_SIZE;
Buffer:= GetMem(BufferSize);
try
// Open source file
fdOldFile:= smbc_open(PChar(OldFileName), O_RDONLY, 0);
if (fdOldFile < 0) then Exit(FS_FILE_READERROR);
// Open target file
fdNewFile:= fpOpen(PChar(LocalName), Flags, $1A4); // $1A4 = &644
if (fdNewFile < 0) then
begin
if errno = ESysEEXIST then
Exit(FS_FILE_EXISTS)
else
Exit(FS_FILE_WRITEERROR);
end;
// Get source file size
FileSize:= smbc_lseek(fdOldFile, 0, SEEK_END);
smbc_lseek(fdOldFile, 0, SEEK_SET);
Written:= 0;
// Copy data
repeat
dwRead:= smbc_read(fdOldFile, Buffer, BufferSize);
if (dwRead < 0) then Exit(FS_FILE_READERROR);
if (dwRead > 0) then
begin
if fpWrite(fdNewFile, Buffer^, dwRead) <> dwRead then
Exit(FS_FILE_WRITEERROR);
Written:= Written + dwRead;
// Calculate percent
Percent:= (Written * 100) div FileSize;
// Update statistics
if ProgressProc(PluginNumber, PChar(OldFileName), LocalName, Percent) = 1 then
Exit(FS_FILE_USERABORT);
end;
until (dwRead = 0);
finally
if Assigned(Buffer) then
FreeMem(Buffer);
if not (fdOldFile < 0) then
smbc_close(fdOldFile);
if not (fdNewFile < 0) then
fpClose(fdNewFile);
end;
Result:= FS_FILE_OK;
end;
function FsPutFile(LocalName, RemoteName: PAnsiChar; CopyFlags: Integer): Integer; cdecl;
var
NewFileName: String;
Buffer: Pointer = nil;
BufferSize: LongWord;
fdOldFile: LongInt;
fdNewFile: LongInt;
dwRead: TSsize;
Written: Int64;
FileSize: Int64;
Percent: LongInt;
Flags: cint = O_CREAT or O_RDWR or O_TRUNC;
begin
NewFileName:= BuildNetworkPath(RemoteName);
if (CopyFlags and FS_COPYFLAGS_OVERWRITE) = 0 then
begin
Flags:= Flags or O_EXCL;
end;
BufferSize:= SMB_BUFFER_SIZE;
Buffer:= GetMem(BufferSize);
try
// Open source file
fdOldFile:= fpOpen(LocalName, O_RDONLY, 0);
if (fdOldFile < 0) then Exit(FS_FILE_READERROR);
// Open target file
fdNewFile:= smbc_open(PChar(NewFileName), Flags, 0);
if (fdNewFile < 0) then
begin
if cerrno = ESysEEXIST then
Exit(FS_FILE_EXISTS)
else
Exit(FS_FILE_WRITEERROR);
end;
// Get source file size
FileSize:= fpLseek(fdOldFile, 0, SEEK_END);
fpLseek(fdOldFile, 0, SEEK_SET);
Written:= 0;
// Copy data
repeat
dwRead:= fpRead(fdOldFile, Buffer^, BufferSize);
if (dwRead < 0) then Exit(FS_FILE_READERROR);
if (dwRead > 0) then
begin
if smbc_write(fdNewFile, Buffer, dwRead) <> dwRead then
Exit(FS_FILE_WRITEERROR);
Written:= Written + dwRead;
// Calculate percent
Percent:= (Written * 100) div FileSize;
// Update statistics
if ProgressProc(PluginNumber, LocalName, PChar(NewFileName), Percent) = 1 then
Exit(FS_FILE_USERABORT);
end;
until (dwRead = 0);
finally
if Assigned(Buffer) then
FreeMem(Buffer);
if not (fdOldFile < 0) then
fpClose(fdOldFile);
if not (fdNewFile < 0) then
smbc_close(fdNewFile);
end;
Result:= FS_FILE_OK;
end;
function FsDeleteFile(RemoteName: PAnsiChar): BOOL; cdecl;
var
FileName: String;
begin
FileName:= BuildNetworkPath(RemoteName);
Result:= smbc_unlink(PChar(FileName)) = 0;
end;
function FsMkDir(RemoteDir: PAnsiChar): BOOL; cdecl;
var
NewDir: String;
begin
NewDir:= BuildNetworkPath(RemoteDir);
Result:= smbc_mkdir(PChar(NewDir), $1FF) = 0; // $1FF = &0777
end;
function FsRemoveDir(RemoteName: PAnsiChar): BOOL; cdecl;
var
RemDir: String;
begin
RemDir:= BuildNetworkPath(RemoteName);
Result:= smbc_rmdir(PChar(RemDir)) = 0;
end;
function FsSetAttr(RemoteName: PAnsiChar; NewAttr: Integer): BOOL; cdecl;
var
FileName: String;
Mode: array[0..10] of AnsiChar;
begin
Mode:= '0x' + HexStr(NewAttr, 8) + #0;
FileName:= BuildNetworkPath(RemoteName);
// smbc_setxattr takes attributes as hex string (like 0x00000000)
Result:= (smbc_setxattr(PChar(FileName), 'system.dos_attr.mode', @Mode, SizeOf(Mode), 0) >= 0);
end;
function FsSetTime(RemoteName: PAnsiChar; CreationTime, LastAccessTime, LastWriteTime: PFileTime): BOOL; cdecl;
var
FileName: String;
tbuf: array[0..1] of timeval;
FileInfo: BaseUnix.Stat;
begin
FileName:= BuildNetworkPath(RemoteName);
if (LastAccessTime = nil) or (LastWriteTime = nil) then
begin
if smbc_stat(PChar(FileName), @FileInfo) < 0 then
Exit(False);
if (LastAccessTime = nil) then
tbuf[0].tv_sec:= FileInfo.st_atime
else
tbuf[0].tv_sec:= FileTimeToUnixTime(LastAccessTime^);
if (LastWriteTime = nil) then
tbuf[1].tv_sec:= FileInfo.st_mtime
else
tbuf[1].tv_sec:= FileTimeToUnixTime(LastWriteTime^);
end
else
begin
tbuf[0].tv_sec:= FileTimeToUnixTime(LastAccessTime^);
tbuf[1].tv_sec:= FileTimeToUnixTime(LastWriteTime^);
end;
Result:= (smbc_utimes(PChar(FileName), @tbuf) = 0);
end;
procedure FsGetDefRootName(DefRootName: PAnsiChar; MaxLen: Integer); cdecl;
begin
StrPLCopy(DefRootName, 'Windows Network', MaxLen);
end;
procedure ExtensionInitialize(StartupInfo: PExtensionStartupInfo); cdecl;
begin
ExtensionStartupInfo:= StartupInfo^;
end;
end.