// Get everything going... int __declspec( dllexport ) __stdcall LoadDll( LOADINFO * limIRC ) { mWnd = limIRC->mHwnd; limIRC->mKeep = TRUE; // TODO: Set to FALSE if the inline perl fails if ( my_perl == NULL ) { /* Get things set for mIRC<=>perl IO */ hMapFile = CreateFileMapping( INVALID_HANDLE_VALUE, 0, PAGE_READWRITE, 0, 4096, NAMESPACE ); mData = ( LPSTR )MapViewOfFile( hMapFile, FILE_MAP_ALL_ACCESS, 0, 0, 0 ); /* Create our persistant interpreter */ char * perl_args[] = { "", "-e", "", "0" }; PERL_SYS_INIT3( NULL, NULL, NULL ); if ( ( my_perl = perl_alloc() ) == NULL ) { mIRC_execute( "/echo Failed to load DLL: No memory" ); /* TODO: make this an error message */ limIRC->mKeep = FALSE; return 0; } perl_construct( my_perl ); PL_origalen = 1; /* Don't let $0 assignment update the proctitle or perl_args[0] */ perl_parse( my_perl, xs_init, 6, perl_args, NULL ); PL_exit_flags |= PERL_EXIT_DESTRUCT_END; perl_run( my_perl ); { #ifdef PERLIO_LAYERS /* Layers available */ PerlIO_define_layer( aTHX_ PERLIO_FUNCS_CAST( &PerlIO_mIRC ) ); PerlIO_apply_layers( aTHX_ PerlIO_stderr( ), NULL, ":mIRC" ); PerlIO_apply_layers( aTHX_ PerlIO_stdout( ), NULL, ":mIRC" ); #endif /* PERLIO_LAYERS */ } SV * result = eval_pv( form( "use FindBin;" /* CORE */ "use lib qq[$FindBin::Bin/lib];" /* Search %mIRC%/lib for modules */ "use lib qq[$FindBin::Bin/perl];" /* Look for modules in %mIRC%/perl */ "my $mIRC = bless \{ }, 'mIRC';"
SV *PerlIONginxInput_newhandle(pTHX_ ngx_http_request_t *r) { ngx_log_t *log = r->connection->log; GV *gv = (GV*)SvREFCNT_inc(newGVgen("Nginx::PSGI::Input")); if (!gv) return &PL_sv_undef; (void) hv_delete(GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv), G_DISCARD); /* Body in memory */ if (r->request_body == NULL || r->request_body->temp_file == NULL) { ngx_log_debug0(NGX_LOG_DEBUG_HTTP, r->connection->log, 0, "Open filehandle with 'ngx_input' layer to read from buffers"); PerlIO *f = PerlIO_allocate(aTHX); if (!(f = PerlIO_push(aTHX_ f, PERLIO_FUNCS_CAST(&PerlIO_nginx_input), "<", NULL)) ) { ngx_log_error(NGX_LOG_ERR, log, 0, "Error pushing layer to FH" ); return &PL_sv_undef; } if (!do_open(gv, "+<&", 3, FALSE, O_RDONLY, 0, f)) { ngx_log_error(NGX_LOG_ERR, log, 0, "Error opening GV" ); // FIXME PerlIO_close return &PL_sv_undef; } PerlIONginxInput *st = PerlIOSelf(f, PerlIONginxInput); st->r = r; } else { /* Body in temp file */ ngx_log_debug1(NGX_LOG_DEBUG_HTTP, r->connection->log, 0, "Open PSGI request body temp file '%s'", r->request_body->temp_file->file.name.data ); bool result = do_open(gv,(char*)r->request_body->temp_file->file.name.data, r->request_body->temp_file->file.name.len,FALSE,O_RDONLY,0,NULL); if (!result) { ngx_log_error(NGX_LOG_ERR, log, 0, "Error opening file" ); // FIXME PerlIO_close return NULL; } } return (SV*)newRV_noinc((SV *)gv); }
PerlInterpreter * ngx_http_psgi_create_interpreter(ngx_conf_t *cf) { int n; PerlInterpreter *perl; ngx_log_debug0(NGX_LOG_DEBUG_HTTP, cf->log, 0, "Create PSGI Perl interpreter"); /* FIXME: Some code from ngx_http_perl_module.c I don't understand */ if (ngx_set_environment(cf->cycle, NULL) == NULL) { return NULL; } perl = perl_alloc(); if (perl == NULL) { ngx_log_error(NGX_LOG_ALERT, cf->log, 0, "perl_alloc() failed"); return NULL; } { char *my_argv[] = { "", "-MIO::Handle", "-e", "0" }; dTHXa(perl); PERL_SET_CONTEXT(perl); perl_construct(perl); n = perl_parse(perl, xs_init, 3, my_argv, NULL); if (n != 0) { ngx_log_error(NGX_LOG_ALERT, cf->log, 3, "perl_parse() failed: %d", n); goto fail; } PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_nginx_error)); } return perl; fail: (void) perl_destruct(perl); perl_free(perl); return NULL; }
SV *PerlIONginxError_newhandle(pTHX_ ngx_http_request_t *r) { GV *gv = (GV*)SvREFCNT_inc(newGVgen("Nginx::PSGI::Error")); if (!gv) return &PL_sv_undef; (void) hv_delete(GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv), G_DISCARD); PerlIO *f = PerlIO_allocate(aTHX); if (!(f = PerlIO_push(aTHX_ f, PERLIO_FUNCS_CAST(&PerlIO_nginx_error), ">", NULL)) ) { return &PL_sv_undef; } if (!do_open(gv, "+>&", 3, FALSE, O_WRONLY, 0, f)) { return &PL_sv_undef; } PerlIONginxError *st = PerlIOSelf(f, PerlIONginxError); st->log = r->connection->log; return newRV_noinc((SV*)gv); }