diff options
author | Perl 5 Porters <perl5-porters@africa.nicoh.com> | 1997-05-08 00:00:00 +1200 |
---|---|---|
committer | Chip Salzenberg <chip@atlantic.net> | 1997-05-08 00:00:00 +1200 |
commit | 7bac28a0157dcaf170649e8928f053f76dda4253 (patch) | |
tree | 88eadd917e84141a07d7cf3db90686edb67fe5a6 /win32/perllib.c | |
parent | eb447b8692d1c89cd24ab421497dcff667570be4 (diff) | |
download | perl-7bac28a0157dcaf170649e8928f053f76dda4253.tar.gz |
[inseparable changes from match from perl-5.003_99 to perl-5.003_99a]
BUILD PROCESS
Subject: AFS patches
From: Chip Salzenberg <chip@perl.com>
Files: Configure installperl
CORE LANGUAGE CHANGES
Subject: SECURITY: Forbid glob() when tainting (-T or setuid)
From: Chip Salzenberg <chip@perl.com>
Files: pod/perlrun.pod pod/perlsec.pod pp_sys.c
Subject: SECURITY: Forbid exec() if $ENV{TERM} or $ENV{ENV} is tainted
From: Chip Salzenberg <chip@perl.com>
Files: pod/perlrun.pod pod/perlsec.pod t/op/taint.t taint.c
CORE PORTABILITY
Subject: (NeXT|Open)Step update
Date: Wed, 7 May 97 17:47:02 -0500
From: Gerd Knops <gerti@BITart.com>
Files: Configure MANIFEST config_h.SH hints/next_3.sh hints/next_4.sh
private-msgid: 9705072247.AA18882@BITart.com
Subject: Win32 update (consolidated patch plus three followups)
From: Gurusamy Sarathy <gsar@engin.umich.edu>
Files: EXTERN.h README.win32 lib/Sys/Hostname.pm pod/perldelta.pod win32/config.H win32/config.w32 win32/config_sh.PL win32/perllib.c win32/win32.c win32/win32.h win32/include/sys/socket.h
DOCUMENTATION
Subject: Updates to perldelta
From: Chip Salzenberg <chip@perl.com>
Files: pod/perldelta.pod
Subject: Document 'Possible attempt to separate words with commas'
Date: 06 May 1997 23:27:55 +0200
From: Gisle Aas <gisle@aas.no>
Files: pod/perlop.pod
Msg-ID: hyb9snvdw.fsf@bergen.sn.no
(applied based on p5p patch as commit 18270fd3b8aafde2f9ea21ea13adde95ef24b149)
Subject: Document that C<m?x?> is just like C<?x?>
From: Chip Salzenberg <chip@perl.com>
Files: pod/perlop.pod
OTHER CORE CHANGES
Subject: Fix for redefined sort subs nastiness
Date: Thu, 08 May 1997 20:04:18 -0400
From: Gurusamy Sarathy <gsar@engin.umich.edu>
Files: op.c pod/perldelta.pod pod/perldiag.pod sv.c t/op/sort.t
Msg-ID: 199705090004.UAA15032@aatma.engin.umich.edu
(applied based on p5p patch as commit e9e069932a0db06904b29e2b09a435afd40ed35c)
Diffstat (limited to 'win32/perllib.c')
-rw-r--r-- | win32/perllib.c | 244 |
1 files changed, 236 insertions, 8 deletions
diff --git a/win32/perllib.c b/win32/perllib.c index f40013b577..0f63938f5c 100644 --- a/win32/perllib.c +++ b/win32/perllib.c @@ -104,7 +104,7 @@ char *staticlinkmodules[] = { EXTERN_C void boot_DynaLoader _((CV* cv)); static -XS(w32_GetCurrentDirectory) +XS(w32_GetCwd) { dXSARGS; SV *sv = sv_newmortal(); @@ -126,22 +126,223 @@ XS(w32_GetCurrentDirectory) } static +XS(w32_SetCwd) +{ + dXSARGS; + if (items != 1) + croak("usage: Win32::SetCurrentDirectory($cwd)"); + if (SetCurrentDirectory(SvPV(ST(0),na))) + XSRETURN_YES; + + XSRETURN_NO; +} + +static +XS(w32_GetNextAvailDrive) +{ + dXSARGS; + char ix = 'C'; + char root[] = "_:\\"; + while (ix <= 'Z') { + root[0] = ix++; + if (GetDriveType(root) == 1) { + root[2] = '\0'; + XSRETURN_PV(root); + } + } + XSRETURN_UNDEF; +} + +static XS(w32_GetLastError) { - dXSARGS; - XSRETURN_IV(GetLastError()); + dXSARGS; + XSRETURN_IV(GetLastError()); } +static +XS(w32_LoginName) +{ + dXSARGS; + char name[256]; + DWORD size = sizeof(name); + if (GetUserName(name,&size)) { + /* size includes NULL */ + ST(0) = sv_2mortal(newSVpv(name,size-1)); + XSRETURN(1); + } + XSRETURN_UNDEF; +} + +static +XS(w32_NodeName) +{ + dXSARGS; + char name[MAX_COMPUTERNAME_LENGTH+1]; + DWORD size = sizeof(name); + if (GetComputerName(name,&size)) { + /* size does NOT include NULL :-( */ + ST(0) = sv_2mortal(newSVpv(name,size)); + XSRETURN(1); + } + XSRETURN_UNDEF; +} + + +static +XS(w32_DomainName) +{ + dXSARGS; + char name[256]; + DWORD size = sizeof(name); + if (GetUserName(name,&size)) { + char sid[1024]; + DWORD sidlen = sizeof(sid); + char dname[256]; + DWORD dnamelen = sizeof(dname); + SID_NAME_USE snu; + if (LookupAccountName(NULL, name, &sid, &sidlen, + dname, &dnamelen, &snu)) { + XSRETURN_PV(dname); /* all that for this */ + } + } + XSRETURN_UNDEF; +} + +static +XS(w32_FsType) +{ + dXSARGS; + char fsname[256]; + DWORD flags, filecomplen; + if (GetVolumeInformation(NULL, NULL, 0, NULL, &filecomplen, + &flags, fsname, sizeof(fsname))) { + if (GIMME == G_ARRAY) { + XPUSHs(sv_2mortal(newSVpv(fsname,0))); + XPUSHs(sv_2mortal(newSViv(flags))); + XPUSHs(sv_2mortal(newSViv(filecomplen))); + PUTBACK; + return; + } + XSRETURN_PV(fsname); + } + XSRETURN_UNDEF; +} + +static +XS(w32_GetOSVersion) +{ + dXSARGS; + OSVERSIONINFO osver; + + osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFO); + if (GetVersionEx(&osver)) { + XPUSHs(newSVpv(osver.szCSDVersion, 0)); + XPUSHs(newSViv(osver.dwMajorVersion)); + XPUSHs(newSViv(osver.dwMinorVersion)); + XPUSHs(newSViv(osver.dwBuildNumber)); + XPUSHs(newSViv(osver.dwPlatformId)); + PUTBACK; + return; + } + XSRETURN_UNDEF; +} + +static XS(w32_IsWinNT) { - dXSARGS; - XSRETURN_IV(IsWinNT()); + dXSARGS; + XSRETURN_IV(IsWinNT()); } +static XS(w32_IsWin95) { - dXSARGS; - XSRETURN_IV(IsWin95()); + dXSARGS; + XSRETURN_IV(IsWin95()); +} + +static +XS(w32_FormatMessage) +{ + dXSARGS; + DWORD source = 0; + char msgbuf[1024]; + + if (items != 1) + croak("usage: Win32::FormatMessage($errno)"); + + if (FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, + &source, SvIV(ST(0)), 0, + msgbuf, sizeof(msgbuf)-1, NULL)) + XSRETURN_PV(msgbuf); + + XSRETURN_UNDEF; +} + +static +XS(w32_Spawn) +{ + dXSARGS; + char *cmd, *args; + PROCESS_INFORMATION stProcInfo; + STARTUPINFO stStartInfo; + BOOL bSuccess = FALSE; + + if(items != 3) + croak("usage: Win32::Spawn($cmdName, $args, $PID)"); + + cmd = SvPV(ST(0),na); + args = SvPV(ST(1), na); + + memset(&stStartInfo, 0, sizeof(stStartInfo)); /* Clear the block */ + stStartInfo.cb = sizeof(stStartInfo); /* Set the structure size */ + stStartInfo.dwFlags = STARTF_USESHOWWINDOW; /* Enable wShowWindow control */ + stStartInfo.wShowWindow = SW_SHOWMINNOACTIVE; /* Start min (normal) */ + + if(CreateProcess( + cmd, /* Image path */ + args, /* Arguments for command line */ + NULL, /* Default process security */ + NULL, /* Default thread security */ + FALSE, /* Must be TRUE to use std handles */ + NORMAL_PRIORITY_CLASS, /* No special scheduling */ + NULL, /* Inherit our environment block */ + NULL, /* Inherit our currrent directory */ + &stStartInfo, /* -> Startup info */ + &stProcInfo)) /* <- Process info (if OK) */ + { + CloseHandle(stProcInfo.hThread);/* library source code does this. */ + sv_setiv(ST(2), stProcInfo.dwProcessId); + bSuccess = TRUE; + } + XSRETURN_IV(bSuccess); +} + +static +XS(w32_GetTickCount) +{ + dXSARGS; + XSRETURN_IV(GetTickCount()); +} + +static +XS(w32_GetShortPathName) +{ + dXSARGS; + SV *shortpath; + + if(items != 1) + croak("usage: Win32::GetShortPathName($longPathName)"); + + shortpath = sv_mortalcopy(ST(0)); + SvUPGRADE(shortpath, SVt_PV); + /* src == target is allowed */ + if (GetShortPathName(SvPVX(shortpath), SvPVX(shortpath), SvCUR(shortpath))) + ST(0) = shortpath; + else + ST(0) = &sv_undef; + XSRETURN(1); } static void @@ -150,9 +351,36 @@ xs_init() char *file = __FILE__; dXSUB_SYS; newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file); - newXS("Win32::GetCurrentDirectory", w32_GetCurrentDirectory, file); + + /* XXX should be removed after checking with Nick */ + newXS("Win32::GetCurrentDirectory", w32_GetCwd, file); + + /* these names are Activeware compatible */ + newXS("Win32::GetCwd", w32_GetCwd, file); + newXS("Win32::SetCwd", w32_SetCwd, file); + newXS("Win32::GetNextAvailDrive", w32_GetNextAvailDrive, file); newXS("Win32::GetLastError", w32_GetLastError, file); + newXS("Win32::LoginName", w32_LoginName, file); + newXS("Win32::NodeName", w32_NodeName, file); + newXS("Win32::DomainName", w32_DomainName, file); + newXS("Win32::FsType", w32_FsType, file); + newXS("Win32::GetOSVersion", w32_GetOSVersion, file); newXS("Win32::IsWinNT", w32_IsWinNT, file); newXS("Win32::IsWin95", w32_IsWin95, file); + newXS("Win32::FormatMessage", w32_FormatMessage, file); + newXS("Win32::Spawn", w32_Spawn, file); + newXS("Win32::GetTickCount", w32_GetTickCount, file); + newXS("Win32::GetShortPathName", w32_GetShortPathName, file); + + /* XXX Bloat Alert! The following Activeware preloads really + * ought to be part of Win32::Sys::*, so they're not included + * here. + */ + /* LookupAccountName + * LookupAccountSID + * InitiateSystemShutdown + * AbortSystemShutdown + * ExpandEnvrironmentStrings + */ } |