fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

2008-06-27 17:13 UTC+0100 Miguel Angel Marchuet <miguelangel@marchuet.net>

Browse Source 
* contrib/hbtip/client.prg
  * contrib/hbtip/ftpcln.prg
  * contrib/hbtip/httpcln.prg
  * contrib/hbtip/mail.prg
  * contrib/hbtip/sendmail.prg
    + Added methods setget to interrogate buffer size send/recive
	   METHOD InetRcvBufSize( SocketCon, nSizeBuff )
	   METHOD InetSndBufSize( SocketCon, nSizeBuff )
    + Added data members to assign default buffer sizes
	   DATA nDefaultRcvBuffSize
	   DATA nDefaultSndBuffSize
    + Asigned default buffer size to 64kb only for FTP transfer, previous to open sockets
           ::nDefaultSndBuffSize := 65536
           ::nDefaultRcvBuffSize := 65536
    * Fixed port ftp protocol.
  * source/rtl/hbinet.c
    * now works with default system buffer, for example 8kb at W2000. instead of harcoded 1400
This commit is contained in:
Miguel Angel Marchuet Frutos
2008-06-27 15:15:12 +00:00
parent 9c03e64b24
commit 06794febf1
8 changed files with 220 additions and 44 deletions
Download Patch File Download Diff File Expand all files Collapse all files

19
harbour/ChangeLog
View File

@@ -8,6 +8,25 @@
2008-12-31 13:59 UTC+0100 Foo Bar <foo.bar@foobar.org>
*/
2008-06-27 17:13 UTC+0100 Miguel Angel Marchuet <miguelangel@marchuet.net>
* contrib/hbtip/client.prg
* contrib/hbtip/ftpcln.prg
* contrib/hbtip/httpcln.prg
* contrib/hbtip/mail.prg
* contrib/hbtip/sendmail.prg
+ Added methods setget to interrogate buffer size send/recive
METHOD InetRcvBufSize( SocketCon, nSizeBuff )
METHOD InetSndBufSize( SocketCon, nSizeBuff )
+ Added data members to assign default buffer sizes
DATA nDefaultRcvBuffSize
DATA nDefaultSndBuffSize
+ Asigned default buffer size to 64kb only for FTP transfer, previous to open sockets
::nDefaultSndBuffSize := 65536
::nDefaultRcvBuffSize := 65536
* Fixed port ftp protocol.
* source/rtl/hbinet.c
* now works with default system buffer, for example 8kb at W2000. instead of harcoded 1400
2008-06-27 17:07 UTC+0200 Viktor Szakats (harbour.01 syenar hu)
* contrib/hbgf/hbgfgtk/msginfo.c
! Blind fix for missing MultiLineDelimiters definition.

14
harbour/contrib/hbtip/Changelog
View File

@@ -8,6 +8,20 @@
2002-12-01 23:12 UTC+0100 Foo Bar <foo.bar@foobar.org>
*/
2008-06-27 17:13 UTC+0100 Miguel Angel Marchuet <miguelangel@marchuet.net>
* client.prg
+ Added methods setget to interrogate buffer size send/recive
METHOD InetRcvBufSize( SocketCon, nSizeBuff )
METHOD InetSndBufSize( SocketCon, nSizeBuff )
+ Added data members to assign default buffer sizes
DATA nDefaultRcvBuffSize
DATA nDefaultSndBuffSize
* ftpcln.prg
+ Asigned default buffer size to 64kb only for FTP transfer, previous to open sockets
::nDefaultSndBuffSize := 65536
::nDefaultRcvBuffSize := 65536
2007-05-20 01:00 UTC+0100 Hannes Ziegler <hz@knowleXbase.com>
* source\tip\thtml.prg

59
harbour/contrib/hbtip/client.prg
View File

@@ -76,10 +76,13 @@
#include "fileio.ch"
#include "tip.ch"
#include "common.ch"
#DEFINE RCV_BUF_SIZE Int( ::InetRcvBufSize( ::SocketCon ) / 2 )
#DEFINE SND_BUF_SIZE Int( ::InetSndBufSize( ::SocketCon ) / 2 )
/**
* Inet Client class
*/
CLASS tIPClient
CLASSDATA bInitSocks INIT .F.
@@ -90,6 +93,9 @@ CLASS tIPClient
DATA SocketCon
Data lTrace
Data nHandle
DATA nDefaultRcvBuffSize
DATA nDefaultSndBuffSize
/* Input stream length */
DATA nLength
@@ -130,6 +136,9 @@ CLASS tIPClient
METHOD lastErrorCode() INLINE ::nLastError
METHOD lastErrorMessage(SocketCon) INLINE ::INetErrorDesc(SocketCon)
METHOD InetRcvBufSize( SocketCon, nSizeBuff )
METHOD InetSndBufSize( SocketCon, nSizeBuff )
PROTECTED:
DATA nLastError INIT 0
@@ -138,11 +147,11 @@ CLASS tIPClient
METHOD InetRecvLine( SocketCon, nLen, size )
METHOD InetRecvAll( SocketCon, cStr1, len )
METHOD InetCount( SocketCon )
METHOD InetSendAll( SocketCon, cData, nLen )
METHOD InetSendAll( SocketCon, cData, nLen )
METHOD InetErrorCode(SocketCon)
METHOD InetErrorDesc(SocketCon)
METHOD InetConnect( cServer, nPort, SocketCon )
METHOD Log()
ENDCLASS
@@ -262,20 +271,20 @@ METHOD Read( nLen ) CLASS tIPClient
IF Empty( nLen ) .or. nLen < 0
// read till end of stream
cStr1 := Space( 1024 )
cStr1 := Space( RCV_BUF_SIZE )
cStr0 := ""
::nLastRead := ::InetRecv( ::SocketCon, @cStr1, 1024 )
::nLastRead := ::InetRecv( ::SocketCon, @cStr1, RCV_BUF_SIZE )
DO WHILE ::nLastRead > 0
::nRead += ::nLastRead
cStr0 += Substr( cStr1, 1, ::nLastRead )
::nLastRead := ::InetRecv( ::SocketCon, @cStr1, 1024 )
::nLastRead := ::InetRecv( ::SocketCon, @cStr1, RCV_BUF_SIZE )
ENDDO
::bEof := .T.
ELSE
// read an amount of data
cStr0 := Space( nLen )
// S.R. if len of file is less than 1024 HB_InetRecvAll return 0
// S.R. if len of file is less than RCV_BUF_SIZE HB_InetRecvAll return 0
// ::nLastRead := HB_InetRecvAll( ::SocketCon, @cStr0, nLen )
::InetRecvAll( ::SocketCon, @cStr0, nLen )
@@ -316,7 +325,7 @@ METHOD ReadToFile( cFile, nMode, nSize ) CLASS tIPClient
::nStatus := 1
DO WHILE ::InetErrorCode( ::SocketCon ) == 0 .and. .not. ::bEof
cData := ::Read( 1024 )
cData := ::Read( RCV_BUF_SIZE )
IF cData == NIL
IF nFout != NIL
Fclose( nFout )
@@ -361,7 +370,7 @@ METHOD WriteFromFile( cFile ) CLASS tIPClient
LOCAL nFin
LOCAL cData
LOCAL nLen
LOCAL nSize, nSent
LOCAL nSize, nSent, nBufSize
::nWrite := 0
::nStatus := 0
@@ -372,6 +381,7 @@ METHOD WriteFromFile( cFile ) CLASS tIPClient
nSize := FSeek( nFin, 0, 2 )
FSeek( nFin, 0 )
nBufSize := SND_BUF_SIZE
// allow initialization of the gauge
nSent := 0
@@ -380,9 +390,8 @@ METHOD WriteFromFile( cFile ) CLASS tIPClient
ENDIF
::nStatus := 1
cData := Space( 1024 )
nLen := Fread( nFin, @cData, 1024 )
cData := Space( nBufSize )
nLen := Fread( nFin, @cData, nBufSize )
DO WHILE nLen > 0
IF ::Write( @cData, nLen ) != nLen
Fclose( nFin )
@@ -392,7 +401,7 @@ METHOD WriteFromFile( cFile ) CLASS tIPClient
IF ! Empty( ::exGauge )
HB_ExecFromArray( ::exGauge, {nSent, nSize, Self} )
ENDIF
nLen := Fread( nFin, @cData, 1024 )
nLen := Fread( nFin, @cData, nBufSize )
ENDDO
// it may happen that the file has lenght 0
@@ -449,9 +458,7 @@ METHOD InetSendAll( SocketCon, cData, nLen ) CLASS tIPClient
nRet := HB_InetSendAll( SocketCon, cData, nLen )
if ::lTrace
::Log( SocketCon, nlen, cData, nRet )
endif
Return nRet
@@ -465,9 +472,7 @@ METHOD InetCount( SocketCon ) CLASS tIPClient
nRet := HB_InetCount( SocketCon )
if ::lTrace
::Log( SocketCon, nRet )
endif
Return nRet
@@ -555,6 +560,14 @@ METHOD InetConnect( cServer, nPort, SocketCon ) CLASS tIPClient
HB_InetConnect( cServer, nPort, SocketCon )
IF ! Empty( ::nDefaultSndBuffSize )
::InetSndBufSize( SocketCon, ::nDefaultSndBuffSize )
ENDIF
IF ! Empty( ::nDefaultRcvBuffSize )
::InetRcvBufSize( SocketCon, ::nDefaultRcvBuffSize )
ENDIF
if ::lTrace
::Log( cServer, nPort, SocketCon )
@@ -563,6 +576,18 @@ METHOD InetConnect( cServer, nPort, SocketCon ) CLASS tIPClient
Return Nil
/* Methods to manage buffers */
METHOD InetRcvBufSize( SocketCon, nSizeBuff ) CLASS tIPClient
IF ! Empty( nSizeBuff )
HB_InetSetRcvBufSize( SocketCon, nSizeBuff )
ENDIF
RETURN HB_InetGetRcvBufSize( SocketCon )
METHOD InetSndBufSize( SocketCon, nSizeBuff ) CLASS tIPClient
IF ! Empty( nSizeBuff )
HB_InetSetSndBufSize( SocketCon, nSizeBuff )
ENDIF
RETURN HB_InetGetSndBufSize( SocketCon )
/* Called from another method with list of parameters and, as last parameter, return code
of function being logged.

49
harbour/contrib/hbtip/ftpcln.prg
View File

@@ -159,7 +159,7 @@ CLASS tIPClientFTP FROM tIPClient
METHOD listFiles( cList )
METHOD MPut
METHOD StartCleanLogFile()
METHOD fileSize( cFileSpec )
METHOD fileSize( cFileSpec )
ENDCLASS
@@ -170,8 +170,10 @@ METHOD New( oUrl,lTrace, oCredentials) CLASS tIPClientFTP
::super:new( oUrl, lTrace, oCredentials)
::nDefaultPort := 21
::nConnTimeout := 3000
::bUsePasv := .T.
::nAccessMode := TIP_RW // a read-write protocol
::bUsePasv := .T.
::nAccessMode := TIP_RW // a read-write protocol
::nDefaultSndBuffSize := 65536
::nDefaultRcvBuffSize := 65536
if ::ltrace
if !file("ftp.log")
@@ -244,9 +246,10 @@ METHOD GetReply() CLASS tIPClientFTP
ENDDO
// 4 and 5 are error codes
IF ::InetErrorCode( ::SocketCon ) != 0 .or. SubStr( ::cReply, 1, 1) >= "4"
IF ::InetErrorCode( ::SocketCon ) != 0 .or. Left( ::cReply, 1 ) >= "4"
RETURN .F.
ENDIF
RETURN .T.
METHOD Pasv() CLASS tIPClientFTP
@@ -299,7 +302,7 @@ RETURN ::GetReply()
METHOD Rest( nPos ) CLASS tIPClientFTP
::InetSendall( ::SocketCon, "REST " + alltrim( Str( iif( Empty( nPos ), 0, nPos ) ) ) + ::cCRLF )
::InetSendall( ::SocketCon, "REST " + AllTrim( Str( iif( Empty( nPos ), 0, nPos ) ) ) + ::cCRLF )
RETURN ::GetReply()
@@ -348,6 +351,17 @@ METHOD TransferStart() CLASS tIPClientFTP
ENDIF
HB_InetTimeout( skt, ::nConnTimeout )
/* Set internal socket send buffer to 64k,
* this should fix the speed problems some users have reported
*/
IF ! Empty( ::nDefaultSndBuffSize )
::InetSndBufSize( skt, ::nDefaultSndBuffSize )
ENDIF
IF ! Empty( ::nDefaultRcvBuffSize )
::InetRcvBufSize( skt, ::nDefaultRcvBuffSize )
ENDIF
::SocketCon := skt
ENDIF
ELSE
@@ -358,6 +372,8 @@ METHOD TransferStart() CLASS tIPClientFTP
::GetReply()
RETURN .F.
ENDIF
HB_InetSetRcvBufSize( ::SocketCon, 65536 )
HB_InetSetSndBufSize( ::SocketCon, 65536 )
ENDIF
RETURN .T.
@@ -373,7 +389,7 @@ METHOD Commit() CLASS tIPClientFTP
ENDIF
// error code?
IF SubStr( ::cReply, 1, 1 ) == "5"
IF Left( ::cReply, 1 ) == "5"
RETURN .F.
ENDIF
@@ -471,11 +487,12 @@ METHOD Stor( cFile ) CLASS tIPClientFTP
ENDIF
::InetSendall( ::SocketCon, "STOR " + cFile + ::cCRLF )
//PM:08-31-2007 Remmed out 'IF ! ::GetReply()' because it always makes Stor() returning .F.
// Causing the uploaded file to be sized ZERO.
//IF ! ::GetReply()
// RETURN .F.
//ENDIF
// It is important not to delete these lines in order not to disrupt the timing of
// the responses, which can lead to failures in transfers.
IF ! ::bUsePasv
::GetReply()
ENDIF
RETURN ::TransferStart()
@@ -623,7 +640,7 @@ METHOD MGET( cSpec,cLocalPath ) CLASS tIPClientFTP
ENDIF
ENDIF
::InetSendAll( ::SocketCon, "NLST "+cSpec + ::cCRLF )
::InetSendAll( ::SocketCon, "NLST " + cSpec + ::cCRLF )
cStr := ::ReadAuxPort()
IF !empty(cStr)
@@ -631,7 +648,7 @@ METHOD MGET( cSpec,cLocalPath ) CLASS tIPClientFTP
FOR each cFile in aFiles
IF !Empty(cFile) //PM:09-08-2007 Needed because of the new HB_aTokens()
::downloadfile( cLocalPath+trim(cFile), trim(cFile) )
ENDIF
ENDIF
NEXT
ENDIF
@@ -733,11 +750,11 @@ RETURN cStr
METHOD Rename( cFrom, cTo ) CLASS tIPClientFTP
Local lResult := .F.
::InetSendAll( ::SocketCon, "RNFR "+ cFrom + ::cCRLF )
::InetSendAll( ::SocketCon, "RNFR " + cFrom + ::cCRLF )
IF ::GetReply()
::InetSendAll( ::SocketCon, "RNTO "+ cTo + ::cCRLF )
::InetSendAll( ::SocketCon, "RNTO " + cTo + ::cCRLF )
lResult := ::GetReply()
ENDIF
@@ -891,7 +908,9 @@ METHOD listFiles( cFileSpec ) CLASS tIPClientFTP
aFile[F_TIME] := cTime
aList[ cEntry:__enumIndex() ] := aFile
ENDIF
NEXT
RETURN aList

4
harbour/contrib/hbtip/httpcln.prg
View File

@@ -378,7 +378,7 @@ METHOD ReadAll() CLASS tIPClientHTTP
METHOD setCookie(cLine) CLASS tIPClientHTTP
//docs from http://www.ietf.org/rfc/rfc2109.txt
local aParam
local cHost,cPath,cName,cValue,aElements, cElement
local cHost, cPath, cName, cValue, aElements, cElement
local cDefaultHost:=::oUrl:cServer, cDefaultPath:=::oUrl:cPath
local x,y
IF empty(cDefaultPath)
@@ -424,7 +424,7 @@ return NIL
METHOD getcookies(cHost,cPath) CLASS tIPClientHTTP
local x,y,aDomKeys:={},aKeys,z,cKey,aPathKeys,nPath
local a,b,cOut:="",c,d
local a, b, cOut := "", c, d
IF cHost=nil
cHost:=::oUrl:cServer
ENDIF

10
harbour/contrib/hbtip/mail.prg
View File

@@ -336,12 +336,12 @@ METHOD ToString() CLASS TipMail
FOR i := 1 TO Len( ::hHeaders )
cElem := Lower(hb_HKeyAt( ::hHeaders, i ))
IF !( cElem == "return-path" ) .and. ;
IF !( cElem == "return-path" ) .and.;
!( cElem == "delivered-to" ) .and.;
!( cElem == "date" ) .and. ;
!( cElem == "date" ) .and.;
!( cElem == "from" ) .and.;
!( cElem == "to" ) .and. ;
!( cElem == "subject" ) .and. ;
!( cElem == "to" ) .and.;
!( cElem == "subject" ) .and.;
!( cElem == "mime-version" )
cRet += hb_HKeyAt( ::hHeaders, i ) + ": " +;
hb_HValueAt( ::hHeaders, i ) + e"\r\n"
@@ -662,7 +662,7 @@ RETURN StrTran( ::getFieldOption( "Content-Type", "name" ), '"', "" )
METHOD isMultiPart CLASS TipMail
RETURN "multipart/" $ Lower( ::GetFieldPart("Content-Type"))
RETURN "multipart/" $ Lower( ::GetFieldPart("Content-Type") )
METHOD getMultiParts( aParts ) CLASS TipMail

1
harbour/contrib/hbtip/sendmail.prg
View File

@@ -323,6 +323,7 @@ FUNCTION HB_SendMail( cServer, nPort, cFrom, aTo, aCC, aBCC, cBody, cSubject, aF
oAttach := TipMail():New()
HB_FNameSplit( cFile,, @cFname, @cFext )
cFile := Lower( cFile )
IF ( cFile LIKE ".+\.(vbd|asn|asz|asd|pqi|tsp|exe|sml|ofml)" ) .OR. ;
( cFile LIKE ".+\.(pfr|frl|spl|gz||stk|ips|ptlk|hqx|mbd)" ) .OR. ;

108
harbour/source/rtl/hbinet.c
View File

@@ -106,8 +106,6 @@
#include <errno.h>
#endif
#define HB_SENDRECV_BUFFER_SIZE 1400
typedef struct _HB_SOCKET_STRUCT
{
HB_SOCKET_T com;
@@ -118,6 +116,8 @@
int timeout;
int timelimit;
PHB_ITEM caPeriodic;
int iSndBufSize;
int iRcvBufSize;
} HB_SOCKET_STRUCT;
#define HB_PARSOCKET( n ) ( ( HB_SOCKET_STRUCT * ) hb_parptrGC( hb_inetSocketFinalize, n ) )
@@ -187,6 +187,9 @@
#include <sys/socket.h>
#include <sys/select.h>
#include <sys/ioctl.h>
#endif
#if defined( HB_OS_OS2 ) || defined( HB_OS_WIN_32 )
/* NET_SIZE_T exists because of shortsightedness on the POSIX committee. BSD
* systems used "int *" as the parameter to accept(), getsockname(),
* getpeername() et al. Consequently many unixes took an int * for that
@@ -457,6 +460,32 @@ static int hb_socketConnect( HB_SOCKET_STRUCT *Socket )
{
HB_SOCKET_SET_ERROR2( Socket, -1, "Timeout" );
}
/*
* Read real buffer sizes from socket
*/
{
int value;
socklen_t len = sizeof(value);
if ( getsockopt( Socket->com, SOL_SOCKET, SO_SNDBUF, (char *) &value, &len ) != SOCKET_ERROR )
{
Socket->iSndBufSize = value;
if (getsockopt( Socket->com, SOL_SOCKET, SO_RCVBUF, (char *) &value, &len ) != SOCKET_ERROR )
{
Socket->iRcvBufSize = value;
}
else
{
Socket->iRcvBufSize = 1400;
}
}
else
{
Socket->iSndBufSize = 1400;
Socket->iRcvBufSize = 1400;
}
}
}
}
@@ -765,6 +794,67 @@ HB_FUNC( HB_INETCLEARPERIODCALLBACK )
}
}
HB_FUNC( HB_INETGETSNDBUFSIZE )
{
HB_SOCKET_STRUCT *Socket = HB_PARSOCKET( 1 );
int value;
socklen_t len = sizeof( value );
if( Socket == NULL )
{
hb_errRT_BASE_SubstR( EG_ARG, 3012, NULL, "HB_INETGETSNDBUFSIZE", HB_ERR_ARGS_BASEPARAMS );
}
getsockopt( Socket->com, SOL_SOCKET, SO_SNDBUF, (char *) &value, &len );
Socket->iSndBufSize = value;
hb_retni( value );
}
HB_FUNC( HB_INETGETRCVBUFSIZE )
{
HB_SOCKET_STRUCT *Socket = HB_PARSOCKET( 1 );
int value;
socklen_t len = sizeof( value );
if( Socket == NULL )
hb_errRT_BASE_SubstR( EG_ARG, 3012, NULL, "HB_INETGETRCVBUFSIZE", HB_ERR_ARGS_BASEPARAMS );
getsockopt( Socket->com, SOL_SOCKET, SO_RCVBUF, (char *) &value, &len );
Socket->iRcvBufSize = value;
hb_retni( value );
}
HB_FUNC( HB_INETSETSNDBUFSIZE )
{
HB_SOCKET_STRUCT *Socket = HB_PARSOCKET( 1 );
int value;
if( Socket == NULL )
hb_errRT_BASE_SubstR( EG_ARG, 3012, NULL, "HB_INETSETSNDBUFSIZE", HB_ERR_ARGS_BASEPARAMS );
value = hb_parni( 2 );
setsockopt( Socket->com, SOL_SOCKET, SO_SNDBUF, (char *) &value, sizeof( value ) );
Socket->iSndBufSize = value;
hb_retni( value );
}
HB_FUNC( HB_INETSETRCVBUFSIZE )
{
HB_SOCKET_STRUCT *Socket = HB_PARSOCKET( 1 );
int value;
if( Socket == NULL )
hb_errRT_BASE_SubstR( EG_ARG, 3012, NULL, "HB_INETSETRCVBUFSIZE", HB_ERR_ARGS_BASEPARAMS );
value = hb_parni( 2 );
setsockopt( Socket->com, SOL_SOCKET, SO_RCVBUF, (char *) &value, sizeof( value ) );
Socket->iRcvBufSize = value;
hb_retni( value );
}
/********************************************************************
* TCP receive and send functions
***/
@@ -805,9 +895,13 @@ static void s_inetRecvInternal( int iMode )
do
{
if( iMode == 1 )
iBufferLen = HB_SENDRECV_BUFFER_SIZE > iMaxLen - iReceived ? iMaxLen - iReceived : HB_SENDRECV_BUFFER_SIZE;
{
iBufferLen = ( Socket->iRcvBufSize > iMaxLen - iReceived ) ? iMaxLen - iReceived : Socket->iRcvBufSize;
}
else
{
iBufferLen = iMaxLen;
}
if( hb_selectReadSocket( Socket ) )
{
@@ -1057,7 +1151,7 @@ HB_FUNC( HB_INETRECVENDBLOCK )
BOOL bProtoFound;
if( Socket == NULL )
if( Socket == NULL )
{
hb_errRT_BASE_SubstR( EG_ARG, 3012, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
return;
@@ -1302,9 +1396,13 @@ static void s_inetSendInternal( int iMode )
while( iSent < iSend )
{
if( iMode == 1 )
iBufferLen = HB_SENDRECV_BUFFER_SIZE > iSend - iSent ? iSend - iSent : HB_SENDRECV_BUFFER_SIZE;
{
iBufferLen = Socket->iSndBufSize > iSend - iSent ? iSend - iSent : Socket->iSndBufSize;
}
else
{
iBufferLen = iSend;
}
iLen = 0;
if( hb_selectWriteSocket( Socket ) )