While working with openSSL library, I met a problem with EVP_EncryptFinal_ex.
Concretely, it fails with fatal error ./crypto/evp/evp_enc.c(348) OpenSSL internal error, assertion failed: b <= sizeof ctx -> buf every time, not depending on algorithm (aes or des).
Here is my code. It is simplified as much as possible.
procedure AESTest;
var
key : TBytes;
keyLen : Integer;
dataIn : string;
dataOut : TBytes;
inLen, outLen, resLen : integer;
// Context of an algorithm pointer
e_ctx : Pointer;
begin
// 256 bit key
keyLen := 32;
setlength(key, KeyLen);
RAND_bytes(#(key[0]), KeyLen);
// Input data to encrypt
dataIn := 'Simple data of 29 bits length';
inLen := length(dataIn);
// Init ctx
e_ctx := EVP_CIPHER_CTX_new();
EVP_CIPHER_CTX_init(e_ctx);
EVP_EncryptInit_ex(e_ctx, EVP_aes_256_cbc, nil, #key[0], nil);
// Prepare ouput buf in order to openSSL docs
outLen := inLen + EVP_CIPHER_CTX_block_size(e_ctx) - 1;
setlength(dataOut, outLen);
EVP_EncryptUpdate(e_ctx, #dataOut[0], outLen, #dataIn[1], inLen);
EVP_EncryptFinal_ex(e_ctx, #dataOut[outLen], resLen);
outLen := outLen + resLen;
setlength(dataOut, outLen);
// ... here goes decryption part but it does not matter now
end;
Just to be precise, imports used:
const
LIB_DLL_NAME = 'libeay32.dll';
type
PEVP_CIPHER_CTX : Pointer;
PEVP_CIPHER : Pointer;
function EVP_CIPHER_CTX_new : PEVP_CIPHER_CTX; cdecl; external LIB_DLL_NAME;
procedure EVP_CIPHER_CTX_init(a: PEVP_CIPHER_CTX); cdecl; external LIB_DLL_NAME;
function EVP_aes_256_cbc : PEVP_CIPHER_CTX; cdecl; external LIB_DLL_NAME;
function RAND_bytes(Arr : PByte; ArrLen : integer) : integer; cdecl; external LIB_DLL_NAME;
function EVP_CIPHER_CTX_block_size(ctx: PEVP_CIPHER_CTX): integer; cdecl; external LIB_DLL_NAME;
function EVP_EncryptInit_ex(ctx: PEVP_CIPHER_CTX; cipher_type: PEVP_CIPHER; Engine : Pointer; key: PByte; iv: PByte): integer; cdecl; external LIB_DLL_NAME;
function EVP_EncryptUpdate(ctx: PEVP_CIPHER_CTX; data_out: PByte; var outl: integer; data_in: PByte; inl: integer): integer; cdecl; external LIB_DLL_NAME;
function EVP_EncryptFinal_ex(ctx: PEVP_CIPHER_CTX; data_out: PByte; var outl: integer): integer; external LIB_DLL_NAME;
I actually tried to read source codes (evp_enc.c) and found the assertion:
OPENSSL_assert(b <= sizeof ctx->buf);
Here b is size of a block for current cypher. This assertion makes sense, but still I can't figure out how it could be failed in my code.
I am trying to beat this problem for a couple of days already, and I would be grateful for any advices.
UPDATE: Here are two lines from evp_enc.c:
b=ctx->cipher->block_size;
OPENSSL_assert(b <= sizeof ctx->buf);
according to the code, b is a size of block for current cipher, for aes_256_cbc it is 16 bit long.
The problem is in your declaration of the function EVP_EncryptFinal_ex. You shoud add cdecl directive (like in all other functions).
So, the new declaration will be:
function EVP_EncryptFinal_ex(ctx: PEVP_CIPHER_CTX; data_out: PByte; var outl: integer): integer; cdecl; external LIB_DLL_NAME;
Related
How can I read a message from a tidtcpserver context without removing it from the read buffer? I want to preview the message and leave it where it is.
Indy is not really designed for peeking data, it would rather that you read whole data, letting it block until the requested data has arrived in full.
That being said, TIdBuffer does have a PeekByte() method:
function PeekByte(AIndex: Integer): Byte;
var
B: Byte;
if AContext.Connection.IOHandler.InputBuffer.Size > 0 then
begin
B := AContext.Connection.IOHandler.InputBuffer.PeekByte(0);
...
end;
Or, if you are looking for something in particular in the buffer (ie, a message delimiter, etc), TIdBuffer has several overloaded IndexOf() methods:
function IndexOf(const AByte: Byte; AStartPos: Integer = 0): Integer; overload;
function IndexOf(const ABytes: TIdBytes; AStartPos: Integer = 0): Integer; overload;
function IndexOf(const AString: string; AStartPos: Integer = 0;
AByteEncoding: IIdTextEncoding = nil
{$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
): Integer; overload;
var
Index: Integer;
Index := AContext.Connection.IOHandler.InputBuffer.IndexOf(SingleByte);
Index := AContext.Connection.IOHandler.InputBuffer.IndexOf(ArrayOfBytes);
Index := AContext.Connection.IOHandler.InputBuffer.IndexOf('string');
...
Does anyone knows the equivalent for Shellexecute command for Linux as active target platform?
procedure ShlOpen( FileName: String ) ;
var prc: TProcess;
begin
prc: = TProcess.Create ( nil ) ;
prc.CommandLine: = 'xdg-open' + FileName;
prc.Execute;
prc.free;
end ;
Ended up wit this:
const
libc = '/usr/lib/libc.dylib';
type
PIOFile = Pointer;
// Create a new stream connected to a pipe running the given command.
function popen(const Command: PAnsiChar; Modes: PAnsiChar): PIOFile; cdecl; external libc name 'popen';
// Close a stream opened by popen and return the status of its child.
function pclose(Stream: PIOFile): Integer; cdecl; external libc name 'pclose';
// Return the EOF indicator for STREAM.
function feof(Stream: PIOFile): Integer; cdecl; external libc name 'feof';
// Read chunks of generic data from STREAM.
function fread(Ptr: Pointer; Size: LongWord; N: LongWord; Stream: PIOFile): LongWord; cdecl; external libc name 'fread';
// Wait for a child to die. When one does, put its status in *STAT_LOC
// and return its process ID. For errors, return (pid_t) -1.
function wait(__stat_loc: PInteger): Integer; cdecl; external libc name 'wait';
procedure TUtils.RunCommand(const CmdLine: string; results: TStrings);
var
Output: PIOFile;
Buffer: PAnsiChar;
TempString: Ansistring;
Line: Ansistring;
BytesRead: Integer;
const
BufferSize: Integer = 1000;
begin
TempString := '';
Output := popen(PAnsiChar(Ansistring(CmdLine)), 'r');
GetMem(Buffer, BufferSize);
if Assigned(Output) then
try
while feof(Output) = 0 do
begin
BytesRead := fread(Buffer, 1, BufferSize, Output);
SetLength(TempString, Length(TempString) + BytesRead);
Move(Buffer^, TempString[Length(TempString) - (BytesRead - 1)], BytesRead);
while Pos(#10, TempString) > 0 do
begin
Line := Copy(TempString, 1, Pos(#10, TempString) - 1);
results.Add(UTF8ToString(Line));
TempString := Copy(TempString, Pos(#10, TempString) + 1, Length(TempString));
end;
end;
finally
pclose(Output);
wait(nil);
FreeMem(Buffer, BufferSize);
end;
end;
I would like to call SPSS 'backend' from Delphi. There is a DLL that I can use (it seems): SPSSio64.DLL. But I can not find the interface definition.
What I have found is an example in PowerBasic:
Read and write SPSS sav files
DECLARE FUNCTION spssOpenRead LIB "spssio32.dll" ALIAS "spssOpenRead#8" (BYVAL fileName AS STRING, BYREF hHandle AS LONG) AS LONG
DECLARE FUNCTION spssCloseRead LIB "spssio32.dll" ALIAS "spssCloseRead#4" (BYVAL hHandle AS LONG) AS LONG
Since I only need functions to read and write a file (all the processing will be done via a syntax in that file), I thought that this example might be enough to deduce how to call equivalent functions from Delphi.
So the question is: how would these declarations be in Delphi (64-bit)?
Based on the SPSS 14.0 for Windows Developer's Guide, and PowerBasic documentation, try something like this:
32-bit:
// spssio32.dll exports both 'spssOpenRead' and 'spssOpenRead#8', which are the same function...
function spssOpenRead(filename: PAnsiChar; var hHandle: Integer): Integer; stdcall; external 'spssio32.dll' {name 'spssOpenRead#8'};
// spssio32.dll exports both 'spssCloseRead' and 'spssCloseRead#4', which are the same function...
function spssCloseRead(hHandle: Integer): Integer; stdcall; external 'spssio32.dll' {name 'spssCloseRead#4'};
64-bit:
// I can't find a copy of spssio64.dll to download, so I can't verify the exported names. Adjust if needed..
function spssOpenRead(filename: PAnsiChar; var hHandle: Integer): Integer; stdcall; external 'spssio64.dll' {name 'spssOpenRead#16'};
function spssCloseRead(hHandle: Integer): Integer; stdcall; external 'spssio64.dll' {name 'spssCloseRead#8'};
For the record, this works:
function LoadDLL(DLLname : string) : Uint64;
var
em : TArithmeticExceptionMask;
begin
em:=GetExceptionmask;
SetExceptionmask(em+[exInvalidOp,exZeroDivide,exOverflow,exUnderflow]);
result:=LoadLibrary(PwideChar(DLLname));
SetExceptionmask(em);
end;
function RunSPSSio(filename : string; instructions : Tinstructions) : boolean;
// This will only read SAV files, not SPS files !
type
TspssOpenRead = function (filename: PAnsiChar; var hHandle: Uint64): Integer;
TspssCloseRead = function(hHandle: Uint64): Integer;
TspssGetInterfaceEncoding = function(hHandle : Uint64): Integer;
TspssSetInterfaceEncoding = function(encoding : integer; hHandle : Uint64): Integer;
const
SPSS_ENCODING_UTF8 = 1;
var
p : integer;
spssOpenRead : TspssOpenRead;
spssCloseRead : TspssCloseRead;
spssGetIFencoding : TspssGetInterfaceEncoding;
spssSetIFencoding : TspssSetInterfaceEncoding;
DLLhandle : Uint64;
fileref : PANSIchar;
begin
result:=false;
DLLhandle:=LoadDLL('C:\SPSS\spssio64.dll'); // hardcoded
if DLLhandle=0
then begin p:=GetLastError();
report('DLL load error '+IntToStr(p));
exit;
end;
try
#SPSSopenRead:=getProcAddress(DLLhandle,'spssOpenRead');
#SPSScloseRead:=getProcAddress(DLLhandle,'spssCloseRead');
#SPSSsetIFencoding:=getProcAddress(DLLhandle,'spssSetInterfaceEncoding');
SPSSsetIFencoding(SPSS_ENCODING_UTF8,DLLhandle);
fileref:=PANSIchar(ANSIstring(filename));
p:=SPSSopenRead(fileref,DLLhandle);
if p<>0
then report('*** SPSSio error '+IntToStr(p))
else begin // SPSS database interactions here
result:=SPSScloseRead(DLLhandle)=0;
end;
finally
freeLibrary(DLLhandle);
end;
end;
I'm a Delphi developer and have never programmed for netware. But I need to find the owner of a file on a netware share. After some research, I got this code snippet from a newsgroup (original author: Chris Morgan). It's basically a way to dynamically load netware dll and get the "owner" information of a file. Please look at the function GetNetwareFileOwner.
The problem is, I don't have direct access to a netware share for testing. I'm sending a small test program every time to a user who tests it by selecting a file on the netware share and then reports the results. I'm getting the error code by a small code insert after the call NWIntScanExtenedInfo where it fails with the error codes given below. Any ideas what can be wrong?
Error codes:
1) At first, the following code gave error 899E (INVALID_FILENAME) on the above call. The file name was in English--no special characters there. And the file was selected on the share with a regular File Open dialog.
2) After that, suspecting a case problem, I commented the two AnsiUpperCase lines to keep the name in original case exactly as the File Open Dialog received it. This gives the error 89FF now (NO_FILES_FOUND_ERROR).
P.S. I compiled the test with Delphi 2007. May be there is a structure problem of the top structure. I haven't checked the byte length and alignment. Will do so.
// netware records and function definitions
type
// sizeof(NW_EXT_FILE_INFO) should be 140 bytes - check byte alignment
NW_EXT_FILE_INFO = record
sequence: integer;
parent: integer;
attributes: integer;
uniqueID: shortint;
flags: shortint;
nameSpace: shortint;
nameLength: shortint;
name: array[0..11] of shortint;
creationDateAndTime: integer;
ownerID: integer;
lastArchiveDateAndTime: integer;
lastArchiverID: integer;
updateDateAndTime: integer;
lastUpdatorID: integer;
dataForkSize: integer;
dataForkFirstFAT: integer;
nextTrusteeEntry: integer;
reserved: array[0..35] of shortint;
inheritedRightsMask: word;
lastAccessDate: word;
deletedFileTime: integer;
deletedDateAndTime: integer;
deletorID: integer;
reserved2: array[0..15] of shortint;
otherForkSize: array[0..1] of integer;
end;
// functions defined in CALWIN32.DLL
TNWCallsInit = function(reserved1: pointer;
reserved2: pointer): integer; stdcall;
TNWCallsTerm = function(reserved: pointer): integer; stdcall;
TNWParseNetWarePath = function(const path: pchar; var conn: cardinal;
var dirhandle: cardinal; newpath: pchar): integer; stdcall;
TNWAllocTemporaryDirectoryHandle = function(conn: cardinal;
dirhandle: cardinal; const path: pchar; var newdirhandle: cardinal;
rightsmask: pshortint): integer; stdcall;
TNWDeallocateDirectoryHandle = function(conn: cardinal;
dirhandle: cardinal): integer; stdcall;
TNWIntScanExtendedInfo = function(conn: cardinal; dirhandle: cardinal;
attrs: shortint; iterhandle: Pinteger; const searchPattern: pchar;
var entryinfo: NW_EXT_FILE_INFO; augmentflag: shortint): integer;
stdcall;
TNWGetObjectName = function(conn: cardinal; objID: integer;
objname: pchar; objtype: pword): integer; stdcall;
const
FA_NORMAL = $00;
FA_HIDDEN = $02;
FA_SYSTEM = $04;
// return codes
SUCCESSFUL = $00;
NOT_MY_RESOURCE = $883C;
// get file owner for Netware server file
function GetNetwareFileOwner(const FilePath: string): string;
var
hcalwin: HINST;
NWCallsInit: TNWCallsInit;
NWParseNetWarePath: TNWParseNetWarePath;
NWAllocTemporaryDirectoryHandle: TNWAllocTemporaryDirectoryHandle;
NWIntScanExtendedInfo: TNWIntScanExtendedInfo;
NWGetObjectName: TNWGetObjectName;
NWDeallocateDirectoryHandle: TNWDeallocateDirectoryHandle;
NWCallsTerm: TNWCallsTerm;
hconn,
hdir,
retcode: cardinal;
filedir: string; { DOS path of parent folder
(upper case) }
nwfilename: string; { DOS filename (upper case) }
nwfiledir: array[0..255] of char; { Netware path of
parent folder }
rights: shortint;
i: integer;
entryinfo: NW_EXT_FILE_INFO;
objtype: word;
begin
Result := '';
// load netware client library and required functions
hcalwin := LoadLibrary('calwin32.dll');
if hcalwin<=0 then exit; // netware client not present on PC
#NWCallsInit := GetProcAddress(hcalwin,'NWCallsInit');
#NWParseNetWarePath := GetProcAddress(hcalwin,'NWParseNetWarePath');
#NWAllocTemporaryDirectoryHandle := GetProcAddress(hcalwin,
'NWAllocTemporaryDirectoryHandle');
#NWIntScanExtendedInfo :=
GetProcAddress(hcalwin,'NWIntScanExtendedInfo');
#NWGetObjectName := GetProcAddress(hcalwin,'NWGetObjectName');
#NWDeallocateDirectoryHandle := GetProcAddress(hcalwin,
'NWDeallocateDirectoryHandle');
#NWCallsTerm := GetProcAddress(hcalwin,'NWCallsTerm');
// initialise netware libs
if NWCallsInit(nil,nil)<>SUCCESSFUL then exit;
try
filedir := AnsiUpperCase(ExtractFileDir(FilePath));
retcode := NWParseNetWarePath(pchar(filedir),hconn,hdir,nwfiledir);
if retcode=NOT_MY_RESOURCE then exit; // local or non-netware disk
// get a dir handle
NWAllocTemporaryDirectoryHandle(hconn,0,nwfiledir,hdir,#rights);
// get the file info
i := -1;
nwfilename := AnsiUpperCase(ExtractFileName(FilePath));
retcode := NWIntScanExtendedInfo(hconn,hdir,
FA_NORMAL+FA_SYSTEM+FA_HIDDEN,
#i,pchar(nwfilename),entryinfo,0);
if retcode=SUCCESSFUL then begin
// get file owner name from ID
SetLength(Result,MAX_PATH);
retcode := NWGetObjectName(hconn,entryinfo.ownerID,
pchar(Result),#objtype);
if retcode=SUCCESSFUL then
SetLength(Result,Length(Result)) // got owner
else SetLength(Result,0); // failed to get owner
end;
// deallocate dir handle
NWDeallocateDirectoryHandle(hconn,hdir);
finally
// clean up
NWCallsTerm(nil);
FreeLibrary(hcalwin);
end;
end;
Are you sure about stdcall? Tru cdecl and so on.
Also, You done give information about delphi's version.
If you use a version BEFORE delphi2009 pchar is a one-byte char.
But if you use delphi2009 or next, pchar is 2 byte char.
So, if you need one byte char you must use PAnsiChar insthead.
I don't know if netware dll parameters are unicode or ansi...
Cher.
A.
Does anyone know a 100% clone of the C/C++ printf for Delphi?
Yes, I know the System.Format function, but it handles things a little different.
For example if you want to format 3 to "003" you need "%03d" in C, but "%.3d" in Delphi.
I have an application written in Delphi which has to be able to format numbers using C format strings, so do you know a snippet/library for that?
Thanks in advance!
You could use the wsprintf() function from Windows.pas. Unfortunately this function is not declared correctly in the Windows.pas so here is a redeclaration:
function wsprintf(Output: PChar; Format: PChar): Integer; cdecl; varargs;
external user32 name {$IFDEF UNICODE}'wsprintfW'{$ELSE}'wsprintfA'{$ENDIF};
procedure TForm1.FormCreate(Sender: TObject);
var
S: String;
begin
SetLength(S, 1024); // wsprintf can work only with max. 1024 characters
SetLength(S, wsprintf(PChar(S), '%s %03d', 'Hallo', 3));
end;
If you want to let the function look more Delphi friendly to the user, you could use the following:
function _FormatC(const Format: string): string; cdecl;
const
StackSlotSize = SizeOf(Pointer);
var
Args: va_list;
Buffer: array[0..1024] of Char;
begin
// va_start(Args, Format)
Args := va_list(PAnsiChar(#Format) + ((SizeOf(Format) + StackSlotSize - 1) and not (StackSlotSize - 1)));
SetString(Result, Buffer, wvsprintf(Buffer, PChar(Format), Args));
end;
const // allows us to use "varargs" in Delphi
FormatC: function(const Format: string): string; cdecl varargs = _FormatC;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(FormatC('%s %03d', 'Hallo', 3));
end;
It's not recommended to use (ws)printf since they are prone to buffer overflow, it would be better to use the safe variants (eg StringCchPrintF). It is already declared in the Jedi Apilib (JwaStrSafe).
Well, I just found this one:
function sprintf(S: PAnsiChar; const Format: PAnsiChar): Integer;
cdecl; varargs; external 'msvcrt.dll';
It simply uses the original sprintf function from msvcrt.dll which can then be used like that:
procedure TForm1.Button1Click(Sender: TObject);
var s: AnsiString;
begin
SetLength(s, 99);
sprintf(PAnsiChar(s), '%d - %d', 1, 2);
ShowMessage(S);
end;
I don't know if this is the best solution because it needs this external dll and you have to set the string's length manually which makes it prone to buffer overflows, but at least it works... Any better ideas?
more clean approach without unnecessary type casting
function sprintf(CharBuf: PChar; const Format: PAnsiChar): Integer;
cdecl; varargs; external 'msvcrt.dll';
procedure TForm1.Button1Click(Sender: TObject);
var CharBuf: PChar;
begin
CharBuf:=StrAlloc (99);
sprintf(CharBuf, 'two numbers %d - %d', 1, 2);
ShowMessage(CharBuf);
StrDispose(CharBuf);
end;
If you happen to cross compile for Windows CE App. use coredll.dll instead of msvcrt.dll