From: Jarkko Hietaniemi Date: Tue, 5 Feb 2002 23:12:19 +0000 (+0000) Subject: NetWare update from Ananth Kesari. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=4d76e4b4b06e50f8d4823ad3dd37d8c202e442e0;p=p5sagit%2Fp5-mst-13.2.git NetWare update from Ananth Kesari. p4raw-id: //depot/perl@14567 --- diff --git a/NetWare/Makefile b/NetWare/Makefile index a1c7e51..7aebdd4 100644 --- a/NetWare/Makefile +++ b/NetWare/Makefile @@ -306,20 +306,25 @@ EXTENSION_NLP = \ # $(CWD_NLP) \ # cwd.pm needs to be modifed for NetWare. -# Begin - Following is required to build NetWare specific extensions Perl2UCS & CGI2Perl -PERL2UCS = $(EXTDIR)\Perl2UCS\Perl2UCS -CGI2PERL = CGI2Perl\CGI2Perl +# Begin - Following is required to build NetWare specific extensions Perl2UCS, UCSExt & CGI2Perl -PERL2UCS_NLP = $(AUTODIR)\Perl2UCS\Perl2UCS.nlp -CGI2PERL_NLP = \CGI2Perl\CGI2Perl.nlp +PERL2UCS = $(EXTDIR)\Perl2UCS\Perl2UCS +UCSEXT = $(EXTDIR)\UCSExt\UCSExt +CGI2PERL = CGI2Perl\CGI2Perl + +PERL2UCS_NLP = $(AUTODIR)\Perl2UCS\Perl2UCS.nlp +UCSEXT_NLP = $(AUTODIR)\UCSExt\UCSExt.nlp +CGI2PERL_NLP = \CGI2Perl\CGI2Perl.nlp NETWARE_EXTNS = \ $(PERL2UCS_NLP) \ + $(UCSEXT_NLP) \ $(CGI2PERL_NLP) # End + ECHO_SRC = TestNLM\echo\echo.c TYPE_SRC = TestNLM\type\type.c ECHO_SRC_OBJ = $(ECHO_SRC:.c=.obj) @@ -388,7 +393,7 @@ BASE_LIBRARIES = !endif #!ifdef WATCOM !endif #!ifndef BASE_LIBRARIES -COPYRIGHT = Copyright 2001 by Novell, Inc. All rights reserved. +COPYRIGHT = (C) Copyright 2001-2002 Novell Inc. All rights reserved. EXPORTS = Export @perl.imp @@ -763,7 +768,7 @@ X2P_OBJ = $(X2P_SRC:.c=.obj) DYNAMIC_EXT = Socket IO Fcntl Opcode SDBM_File POSIX attrs Thread B re \ Data/Dumper Devel/Peek ByteLoader Devel/DProf File/Glob \ Storable/Storable List/Util MIME/Base64/Base64 \ - XS/Typemap/Typemap Unicode/Normalize/Normalize Sys/Hostnamees + XS/Typemap/Typemap Unicode/Normalize/Normalize Sys/Hostname STATIC_EXT = DynaLoader @@ -939,7 +944,7 @@ HEADERS : @copy << stdio.h >\nul /* - * Copyright © 2001 Novell, Inc. All Rights Reserved. + * (C) Copyright 2001-2002 Novell Inc. All rights reserved. * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -976,7 +981,7 @@ HEADERS : @copy << string.h >\nul /* - * Copyright © 2001 Novell, Inc. All Rights Reserved. + * (C) Copyright 2001-2002 Novell Inc. All rights reserved. * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -1171,7 +1176,7 @@ $(EXT_MAIN_OBJ) : $(CLIB_H_FILES) # $(MINIPERL) -I..\lib config_sh.PL $(NW_CFG_VARS) config.nw5 > ..\config.sh # @pause # cd .. -# del config.sh +# del /f /q config.sh # rename nwconfig.sh config.sh # cd netware @@ -1406,6 +1411,14 @@ $(PERL2UCS_NLP): cd ..\..\netware !endif +$(UCSEXT_NLP): +!if "$(NW_EXTNS)"=="yes" + cd $(EXTDIR)\$(*B) + ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl + $(MAKE) + cd ..\..\netware +!endif + nwclean: -rmdir /s /q $(REL_DIR) -rmdir /s /q $(DEB_DIR) @@ -1473,7 +1486,7 @@ distclean: clean nwclean -del /f /q $(CONFIGPM) -del /f /q bin\*.bat cd $(EXTDIR) - -del /s /q *.lib *.def *.map *.pdb *.bs Makefile *$(o) pm_to_blib *.xdc *.err + -del /s /f /q *.lib *.def *.map *.pdb *.bs Makefile *$(o) pm_to_blib *.xdc *.err cd ..\netware !if "$(NW_EXTNS)"=="yes" cd cgi2perl @@ -1482,6 +1495,9 @@ distclean: clean nwclean cd $(EXTDIR)\Perl2UCS -del /f /q *.obj *.bs Makefile *$(o) *.c pm_to_blib *.xdc *.err *.sym *.map *.c cd ..\..\netware + cd $(EXTDIR)\UCSExt + -del /f /q *.obj *.bs Makefile *$(o) *.c pm_to_blib *.xdc *.err *.sym *.map *.c + cd ..\..\netware !endif -rmdir /s /q $(AUTODIR) -rmdir /s /q $(COREDIR) diff --git a/NetWare/bat/BldNWExt.bat b/NetWare/bat/BldNWExt.bat index bdeddbb..c3598c0 100644 --- a/NetWare/bat/BldNWExt.bat +++ b/NetWare/bat/BldNWExt.bat @@ -3,7 +3,7 @@ @rem CREATED: Sat Apr 14 13:05:44 2001 @rem LAST REVISED: Sat Apr 14 2001 @rem Batch file to toggle b/n building and not building NetWare -@rem specific extns - cgi2perl & perl2ucs. +@rem specific extns - cgi2perl, perl2ucs & ucsext. if "%1" == "" goto Usage diff --git a/NetWare/dl_netware.xs b/NetWare/dl_netware.xs index 766ceb8..e02396b 100644 --- a/NetWare/dl_netware.xs +++ b/NetWare/dl_netware.xs @@ -107,11 +107,11 @@ dl_load_file(filename,flags=0) nlmHandle = FindNLMHandle(mod_name8); } } - //use UCSExt encountered- + //use Perl2UCS or UCSExt encountered : //initialize UCS, this has to be terminated when the script finishes execution //Is the script intending to use UCS Extensions? //This should be done once per script execution - if (strcmp(mod_name,"Perl2UCS.nlp")==0) + if ((strcmp(mod_name,"Perl2UCS.nlp")==0) || (strcmp(mod_name,"UCSExt.nlp")==0)) { unsigned int moduleHandle = 0; moduleHandle = FindNLMHandle("UCSCORE.NLM"); diff --git a/NetWare/interface.c b/NetWare/interface.c index 43cf81a..0788e3a 100644 --- a/NetWare/interface.c +++ b/NetWare/interface.c @@ -26,6 +26,8 @@ EXTERN_C int RunPerl(int argc, char **argv, char **env); EXTERN_C void Perl_nw5_init(int *argcp, char ***argvp); EXTERN_C void boot_DynaLoader (pTHX_ CV* cv); +EXTERN_C BOOL Remove_Thread_Ctx(void); + ClsPerlHost::ClsPerlHost() { @@ -80,8 +82,17 @@ void ClsPerlHost::PerlDestroy(PerlInterpreter *my_perl) { perl_destruct(my_perl); // Destructor for Perl. +} + +void +ClsPerlHost::PerlFree(PerlInterpreter *my_perl) +{ perl_free(my_perl); // Free the memory allocated for Perl. + // Remove the thread context set during Perl_set_context + // This is added here since for web script there is no other place this gets executed + // and it cannot be included into cgi2perl.xs unless this symbol is exported. + Remove_Thread_Ctx(); } /*============================================================================================ @@ -151,12 +162,15 @@ int RunPerl(int argc, char **argv, char **env) } nlm.PerlDestroy(my_perl); } + if(my_perl) + nlm.PerlFree(my_perl); #ifdef USE_ITHREADS if (new_perl) { PERL_SET_THX(new_perl); nlm.PerlDestroy(new_perl); + nlm.PerlFree(my_perl); } #endif @@ -174,7 +188,7 @@ int RunPerl(int argc, char **argv, char **env) // IPerlHost* AllocStdPerl() { - return new ClsPerlHost(); + return (IPerlHost*) new ClsPerlHost(); } @@ -186,7 +200,7 @@ IPerlHost* AllocStdPerl() // void FreeStdPerl(IPerlHost* pPerlHost) { - delete (ClsPerlHost*) pPerlHost; + if (pPerlHost) + delete (ClsPerlHost*) pPerlHost; } - diff --git a/NetWare/interface.h b/NetWare/interface.h index ab24e5c..44d6152 100644 --- a/NetWare/interface.h +++ b/NetWare/interface.h @@ -36,6 +36,8 @@ public: int PerlParse(PerlInterpreter *my_perl, int argc, char** argv, char** env); int PerlRun(PerlInterpreter *my_perl); void PerlDestroy(PerlInterpreter *my_perl); + void PerlFree(PerlInterpreter *my_perl); + bool RegisterWithThreadTable(void); bool UnregisterWithThreadTable(void); }; diff --git a/NetWare/iperlhost.h b/NetWare/iperlhost.h index 4079a6e..53bc879 100644 --- a/NetWare/iperlhost.h +++ b/NetWare/iperlhost.h @@ -34,6 +34,8 @@ public: virtual int PerlParse(PerlInterpreter *my_perl,int argc, char** argv, char** env) = 0; virtual int PerlRun(PerlInterpreter *my_perl) = 0; virtual void PerlDestroy(PerlInterpreter *my_perl) = 0; + virtual void PerlFree(PerlInterpreter *my_perl) = 0; + virtual bool RegisterWithThreadTable(void)=0; virtual bool UnregisterWithThreadTable(void)=0; }; diff --git a/NetWare/nw5.c b/NetWare/nw5.c index 5dd8927..743fd34 100644 --- a/NetWare/nw5.c +++ b/NetWare/nw5.c @@ -212,7 +212,7 @@ long nw_telldir(DIR *dirp) { dTHX; - Perl_croak(aTHX_ "telldir function is not implemented"); + Perl_croak(aTHX_ "The telldir() function is not implemented on NetWare\n"); return 0l; } @@ -298,7 +298,7 @@ nw_crypt(const char *txt, const char *salt) dTHR; return des_fcrypt(txt, salt, w32_crypt_buffer); #else - Perl_croak(aTHX_ "The crypt() function is unimplemented due to excessive paranoia."); + Perl_croak(aTHX_ "The crypt() function is not implemented on NetWare\n"); return Nullch; #endif } @@ -394,6 +394,8 @@ nw_fileno(FILE *pf) int nw_flock(int fd, int oper) { + dTHX; + Perl_croak(aTHX_ "The flock() function is not implemented on NetWare\n"); return 0; } @@ -753,7 +755,7 @@ void nw_rewinddir(DIR *dirp) { dTHX; - Perl_croak(aTHX_ "rewinddir function is not implemented"); + Perl_croak(aTHX_ "The rewinddir() function is not implemented on NetWare\n"); } void @@ -767,7 +769,7 @@ void nw_seekdir(DIR *dirp, long loc) { dTHX; - Perl_croak(aTHX_ "seekdir function is not implemented"); + Perl_croak(aTHX_ "The seekdir() function is not implemented on NetWare\n"); } int * diff --git a/NetWare/nw5sck.c b/NetWare/nw5sck.c index c1a42fe..91b8afd 100644 --- a/NetWare/nw5sck.c +++ b/NetWare/nw5sck.c @@ -25,6 +25,11 @@ #include #include +// This is defined here since arpa\inet.h defines this array as an extern, +// and arpa\inet.h gets included by the inet_ntoa call. +char nwinet_scratch[18] = {'\0'}; + + u_long nw_htonl(u_long hostlong) { @@ -225,6 +230,12 @@ nw_inet_addr(const char *cp) return inet_addr((char*)cp); } +char * +nw_inet_ntoa(struct in_addr in) +{ + return inet_ntoa(in); +} + SOCKET nw_socket(int af, int type, int protocol) { diff --git a/NetWare/nw5sck.h b/NetWare/nw5sck.h index b32493f..5c0e333 100644 --- a/NetWare/nw5sck.h +++ b/NetWare/nw5sck.h @@ -103,6 +103,7 @@ int nw_getsockname(SOCKET s, struct sockaddr *addr, int *addrlen); int nw_getsockopt(SOCKET s, int level, int optname, char *optval, int *optlen); unsigned long nw_inet_addr(const char *cp); +char * nw_inet_ntoa(struct in_addr in); void nw_endhostent(); void nw_endnetent(); diff --git a/NetWare/nw5thread.h b/NetWare/nw5thread.h index 930273b..c4e17d1 100644 --- a/NetWare/nw5thread.h +++ b/NetWare/nw5thread.h @@ -100,7 +100,7 @@ typedef unsigned long perl_mutex; //For now let us just see when this happens -sgp. #define COND_INIT(c) \ STMT_START { \ - ConsolePrintf("In COND_INIT\n"); \ + /*ConsolePrintf("In COND_INIT\n"); */\ } STMT_END /* (c)->waiters = 0; \ @@ -110,7 +110,7 @@ typedef unsigned long perl_mutex; #define COND_SIGNAL(c) \ STMT_START { \ - ConsolePrintf("In COND_SIGNAL\n"); \ + /*ConsolePrintf("In COND_SIGNAL\n"); */\ } STMT_END /*if ((c)->waiters > 0 && \ SignalLocalSemaphore((c)->sem) != 0) \ @@ -118,7 +118,7 @@ typedef unsigned long perl_mutex; #define COND_BROADCAST(c) \ STMT_START { \ - ConsolePrintf("In COND_BROADCAST\n"); \ + /*ConsolePrintf("In COND_BROADCAST\n"); */\ } STMT_END /*if ((c)->waiters > 0 ) { \ @@ -130,13 +130,13 @@ typedef unsigned long perl_mutex; } \*/ #define COND_WAIT(c, m) \ STMT_START { \ - ConsolePrintf("In COND_WAIT\n"); \ + /*ConsolePrintf("In COND_WAIT\n"); */\ } STMT_END #define COND_DESTROY(c) \ STMT_START { \ - ConsolePrintf("In COND_DESTROY\n"); \ + /*ConsolePrintf("In COND_DESTROY\n"); */\ } STMT_END /* (c)->waiters = 0; \ diff --git a/NetWare/t/NWModify.pl b/NetWare/t/NWModify.pl index 2b1d07b..4e98174 100644 --- a/NetWare/t/NWModify.pl +++ b/NetWare/t/NWModify.pl @@ -88,7 +88,6 @@ sub Process_File open(FH, "+< $FileToProcess") or die "Unable to open the file, $FileToProcess for reading and writing.\n"; @ARRAY = ; # Get the contents of the file into an array. - flock(FH, LOCK_EX); # Lock the file for safety purposes. foreach $Line(@ARRAY) # Get each line of the file. { if($Line =~ m/\@INC = /) @@ -112,7 +111,6 @@ sub Process_File seek(FH, 0, 0); # Seek to the beginning. print FH @ARRAY; # Write the changed array into the file. - flock(FH, LOCK_UN); # unlock the file. close FH; # close the file. $FilesRead++; # One more file read. diff --git a/NetWare/t/NWScripts.pl b/NetWare/t/NWScripts.pl index 8ab3929..cb2938e 100644 --- a/NetWare/t/NWScripts.pl +++ b/NetWare/t/NWScripts.pl @@ -41,7 +41,6 @@ print "Generating t/nwauto.pl ...\n\n\n"; open(FHWA, "> t/nwauto.pl") or die "Unable to open the file, t/nwauto.pl for writing.\n"; seek(FHWA, 0, 0); # seek to the beginning of the file. -flock(FHWA, LOCK_EX); # Lock the file for safety purposes. $version = sprintf("%vd",$^V); print FHWA "\n\nprint \"Automated Unit Testing of Perl$version for NetWare\\n\\n\\n\"\;\n\n\n"; @@ -70,7 +69,6 @@ foreach $FileName(@DirNames) # Write into the intermediary auto script. open(FHW, ">> $IntAutoScript") or die "Unable to open the file, $IntAutoScript for appending.\n"; seek(FHW, 0, 2); # seek to the end of the file. - flock(FHW, LOCK_EX); # Lock the file for safety purposes. $pos = tell(FHW); if($pos <= 0) @@ -97,7 +95,6 @@ foreach $FileName(@DirNames) $index++; } - flock(FHW, LOCK_UN); # unlock the file. close FHW; # close the file. if($index <= 0) @@ -169,12 +166,10 @@ foreach $DirItem(@Dirs) # Write into the intermediary auto script. open(FHW, ">> $IntAutoScript") or die "Unable to open the file, $IntAutoScript for appending.\n"; seek(FHW, 0, 2); # seek to the end of the file. - flock(FHW, LOCK_EX); # Lock the file for safety purposes. # Write into the intermediary auto script. print FHW "\nprint \"Testing of $DirItem folder done!\\n\\n\"\;\n\n"; - flock(FHW, LOCK_UN); # unlock the file. close FHW; # close the file. } } @@ -184,7 +179,6 @@ foreach $DirItem(@Dirs) # Write into nwauto.pl print FHWA "\nprint \"Automated Unit Testing of Perl$version for NetWare done!\\n\\n\"\;\n\n"; -flock(FHWA, LOCK_UN); # unlock the file. close FHWA; # close the file. print "\n\nGeneration of t/nwauto.pl Done!\n\n"; diff --git a/makedef.pl b/makedef.pl index e2cc21b..3bddf39 100644 --- a/makedef.pl +++ b/makedef.pl @@ -1059,6 +1059,7 @@ foreach my $symbol (qw( nw_setprotoent nw_setservent nw_setsockopt + nw_inet_ntoa nw_shutdown nw_crypt nw_execvp