/* * "The Road goes ever on and on, down from the door where it began." */ #ifdef __cplusplus extern "C" { #endif #include "EXTERN.h" #include "perl.h" #include "XSUB.h" #ifdef __cplusplus } # define EXTERN_C extern "C" #else # define EXTERN_C extern #endif static void xs_init _((void)); __declspec(dllexport) int RunPerl(int argc, char **argv, char **env, void *iosubsystem) { int exitstatus; PerlInterpreter *my_perl; void *pOldIOSubsystem; pOldIOSubsystem = SetIOSubSystem(iosubsystem); PERL_SYS_INIT(&argc,&argv); perl_init_i18nl10n(1); if (!(my_perl = perl_alloc())) return (1); perl_construct( my_perl ); perl_destruct_level = 0; exitstatus = perl_parse( my_perl, xs_init, argc, argv, env); if (!exitstatus) { exitstatus = perl_run( my_perl ); } perl_destruct( my_perl ); perl_free( my_perl ); PERL_SYS_TERM(); SetIOSubSystem(pOldIOSubsystem); return (exitstatus); } extern HANDLE PerlDllHandle; BOOL APIENTRY DllMain(HANDLE hModule, /* DLL module handle */ DWORD fdwReason, /* reason called */ LPVOID lpvReserved) /* reserved */ { switch (fdwReason) { /* The DLL is attaching to a process due to process * initialization or a call to LoadLibrary. */ case DLL_PROCESS_ATTACH: /* #define DEFAULT_BINMODE */ #ifdef DEFAULT_BINMODE setmode( fileno( stdin ), O_BINARY ); setmode( fileno( stdout ), O_BINARY ); setmode( fileno( stderr ), O_BINARY ); _fmode = O_BINARY; #endif PerlDllHandle = hModule; break; /* The DLL is detaching from a process due to * process termination or call to FreeLibrary. */ case DLL_PROCESS_DETACH: break; /* The attached process creates a new thread. */ case DLL_THREAD_ATTACH: break; /* The thread of the attached process terminates. */ case DLL_THREAD_DETACH: break; default: break; } return TRUE; } /* Register any extra external extensions */ char *staticlinkmodules[] = { "DynaLoader", NULL, }; EXTERN_C void boot_DynaLoader _((CV* cv)); static XS(w32_GetCwd) { dXSARGS; SV *sv = sv_newmortal(); /* Make one call with zero size - return value is required size */ DWORD len = GetCurrentDirectory((DWORD)0,NULL); SvUPGRADE(sv,SVt_PV); SvGROW(sv,len); SvCUR(sv) = GetCurrentDirectory((DWORD) SvLEN(sv), SvPVX(sv)); /* * If result != 0 * then it worked, set PV valid, * else leave it 'undef' */ if (SvCUR(sv)) SvPOK_on(sv); EXTEND(sp,1); ST(0) = sv; XSRETURN(1); } 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()); } 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()); } static XS(w32_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 xs_init() { char *file = __FILE__; dXSUB_SYS; newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, 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 */ }