void init_idamsg_io(pTHX)
{
tracemsg("init_idamsg_io1\n");
PerlIO_define_layer(aTHX_ &PerlIO_idamsg);
//binmode ":idamsg", stdout;
PerlIO_push(aTHX_ PerlIO_stdout(), &PerlIO_idamsg, "a", NULL);
//binmode ":idamsg", stderr;
PerlIO_push(aTHX_ PerlIO_stderr(), &PerlIO_idamsg, "a", NULL);
}
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);
}
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);
}
IV
PerlIOEncode_fill(pTHX_ PerlIO * f)
{
PerlIOEncode *e = PerlIOSelf(f, PerlIOEncode);
dSP;
IV code = 0;
PerlIO *n;
SSize_t avail;
if (PerlIO_flush(f) != 0)
return -1;
n = PerlIONext(f);
if (!PerlIO_fast_gets(n)) {
/* Things get too messy if we don't have a buffer layer
push a :perlio to do the job */
char mode[8];
n = PerlIO_push(aTHX_ n, &PerlIO_perlio, PerlIO_modestr(f,mode), Nullsv);
if (!n) {
Perl_die(aTHX_ "panic: cannot push :perlio for %p",f);
}
}
PUSHSTACKi(PERLSI_MAGIC);
SPAGAIN;
ENTER;
SAVETMPS;
retry:
avail = PerlIO_get_cnt(n);
if (avail <= 0) {
avail = PerlIO_fill(n);
if (avail == 0) {
avail = PerlIO_get_cnt(n);
}
else {
if (!PerlIO_error(n) && PerlIO_eof(n))
avail = 0;
}
}
if (avail > 0 || (e->flags & NEEDS_LINES)) {
STDCHAR *ptr = PerlIO_get_ptr(n);
SSize_t use = (avail >= 0) ? avail : 0;
SV *uni;
char *s = NULL;
STRLEN len = 0;
e->base.ptr = e->base.end = (STDCHAR *) NULL;
(void) PerlIOEncode_get_base(aTHX_ f);
if (!e->dataSV)
e->dataSV = newSV(0);
if (SvTYPE(e->dataSV) < SVt_PV) {
sv_upgrade(e->dataSV,SVt_PV);
}
if (e->flags & NEEDS_LINES) {
/* Encoding needs whole lines (e.g. iso-2022-*)
search back from end of available data for
and line marker
*/
STDCHAR *nl = ptr+use-1;
while (nl >= ptr) {
if (*nl == '\n') {
break;
}
nl--;
}
if (nl >= ptr && *nl == '\n') {
/* found a line - take up to and including that */
use = (nl+1)-ptr;
}
else if (avail > 0) {
/* No line, but not EOF - append avail to the pending data */
sv_catpvn(e->dataSV, (char*)ptr, use);
PerlIO_set_ptrcnt(n, ptr+use, 0);
goto retry;
}
else if (!SvCUR(e->dataSV)) {
goto end_of_file;
}
}
if (SvCUR(e->dataSV)) {
/* something left over from last time - create a normal
SV with new data appended
*/
if (use + SvCUR(e->dataSV) > e->base.bufsiz) {
if (e->flags & NEEDS_LINES) {
/* Have to grow buffer */
e->base.bufsiz = use + SvCUR(e->dataSV);
PerlIOEncode_get_base(aTHX_ f);
}
else {
use = e->base.bufsiz - SvCUR(e->dataSV);
}
}
sv_catpvn(e->dataSV,(char*)ptr,use);
}
else {
/* Create a "dummy" SV to represent the available data from layer below */
if (SvLEN(e->dataSV) && SvPVX_const(e->dataSV)) {
Safefree(SvPVX_mutable(e->dataSV));
}
if (use > (SSize_t)e->base.bufsiz) {
if (e->flags & NEEDS_LINES) {
/* Have to grow buffer */
e->base.bufsiz = use;
PerlIOEncode_get_base(aTHX_ f);
}
else {
use = e->base.bufsiz;
}
}
SvPV_set(e->dataSV, (char *) ptr);
SvLEN_set(e->dataSV, 0); /* Hands off sv.c - it isn't yours */
SvCUR_set(e->dataSV,use);
SvPOK_only(e->dataSV);
}
SvUTF8_off(e->dataSV);
PUSHMARK(sp);
XPUSHs(e->enc);
XPUSHs(e->dataSV);
XPUSHs(e->chk);
PUTBACK;
if (call_method("decode", G_SCALAR) != 1) {
Perl_die(aTHX_ "panic: decode did not return a value");
}
SPAGAIN;
uni = POPs;
PUTBACK;
/* Now get translated string (forced to UTF-8) and use as buffer */
if (SvPOK(uni)) {
s = SvPVutf8(uni, len);
#ifdef PARANOID_ENCODE_CHECKS
if (len && !is_utf8_string((U8*)s,len)) {
Perl_warn(aTHX_ "panic: decode did not return UTF-8 '%.*s'",(int) len,s);
}
#endif
}
if (len > 0) {
/* Got _something */
/* if decode gave us back dataSV then data may vanish when
we do ptrcnt adjust - so take our copy now.
(The copy is a pain - need a put-it-here option for decode.)
*/
sv_setpvn(e->bufsv,s,len);
e->base.ptr = e->base.buf = (STDCHAR*)SvPVX(e->bufsv);
e->base.end = e->base.ptr + SvCUR(e->bufsv);
PerlIOBase(f)->flags |= PERLIO_F_RDBUF;
SvUTF8_on(e->bufsv);
/* Adjust ptr/cnt not taking anything which
did not translate - not clear this is a win */
/* compute amount we took */
use -= SvCUR(e->dataSV);
PerlIO_set_ptrcnt(n, ptr+use, (avail-use));
/* and as we did not take it it isn't pending */
SvCUR_set(e->dataSV,0);
} else {
/* Got nothing - assume partial character so we need some more */
/* Make sure e->dataSV is a normal SV before re-filling as
buffer alias will change under us
*/
s = SvPV(e->dataSV,len);
sv_setpvn(e->dataSV,s,len);
PerlIO_set_ptrcnt(n, ptr+use, (avail-use));
goto retry;
}
}
else {
end_of_file:
code = -1;
if (avail == 0)
PerlIOBase(f)->flags |= PERLIO_F_EOF;
else
PerlIOBase(f)->flags |= PERLIO_F_ERROR;
}
FREETMPS;
LEAVE;
POPSTACK;
return code;
}
PerlIO *
PerlIOWin32_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers, IV n, const char *mode, int fd, int imode, int perm, PerlIO *f, int narg, SV **args)
{
const char *tmode = mode;
HANDLE h = INVALID_HANDLE_VALUE;
if (f)
{
/* Close if already open */
if (PerlIOBase(f)->flags & PERLIO_F_OPEN)
(*PerlIOBase(f)->tab->Close)(aTHX_ f);
}
if (narg > 0)
{
char *path = SvPV_nolen(*args);
DWORD access = 0;
/* CRT uses _SH_DENYNO for open(), this the Win32 equivelent */
DWORD share = FILE_SHARE_READ | FILE_SHARE_WRITE;
DWORD create = -1;
DWORD attr = FILE_ATTRIBUTE_NORMAL;
if (stricmp(path, "/dev/null")==0)
path = "NUL";
if (*mode == '#')
{
/* sysopen - imode is UNIX-like O_RDONLY etc.
- do_open has converted that back to string form in mode as well
- perm is UNIX like permissions
*/
mode++;
}
else
{
/* Normal open - decode mode string */
}
switch(*mode)
{
case 'r':
access = GENERIC_READ;
create = OPEN_EXISTING;
if (*++mode == '+')
{
access |= GENERIC_WRITE;
create = OPEN_ALWAYS;
mode++;
}
break;
case 'w':
access = GENERIC_WRITE;
create = TRUNCATE_EXISTING;
if (*++mode == '+')
{
access |= GENERIC_READ;
mode++;
}
break;
case 'a':
access = GENERIC_WRITE;
create = OPEN_ALWAYS;
if (*++mode == '+')
{
access |= GENERIC_READ;
mode++;
}
break;
}
if (*mode == 'b')
{
mode++;
}
else if (*mode == 't')
{
mode++;
}
if (*mode || create == -1)
{
SETERRNO(EINVAL,LIB$_INVARG);
return NULL;
}
h = CreateFile(path,access,share,NULL,create,attr,NULL);
if (h == INVALID_HANDLE_VALUE)
{
if (create == TRUNCATE_EXISTING)
h = CreateFile(path,access,share,NULL,(create = OPEN_ALWAYS),attr,NULL);
}
}
else
{
/* fd open */
h = INVALID_HANDLE_VALUE;
if (fd >= 0 && fd <= max_open_fd)
{
PerlIOWin32 *s = fdtable[fd];
if (s)
{
s->refcnt++;
if (!f)
f = PerlIO_allocate(aTHX);
*f = &s->base;
return f;
}
}
if (*mode == 'I')
{
mode++;
switch(fd)
{
case 0:
h = GetStdHandle(STD_INPUT_HANDLE);
break;
case 1:
h = GetStdHandle(STD_OUTPUT_HANDLE);
break;
case 2:
h = GetStdHandle(STD_ERROR_HANDLE);
break;
}
}
}
if (h != INVALID_HANDLE_VALUE)
fd = win32_open_osfhandle((intptr_t) h, PerlIOUnix_oflags(tmode));
if (fd >= 0)
{
PerlIOWin32 *s;
if (!f)
f = PerlIO_allocate(aTHX);
s = PerlIOSelf(PerlIO_push(aTHX_ f,self,tmode,PerlIOArg),PerlIOWin32);
s->h = h;
s->fd = fd;
s->refcnt = 1;
if (fd >= 0)
{
fdtable[fd] = s;
if (fd > max_open_fd)
max_open_fd = fd;
}
return f;
}
if (f)
{
/* FIXME: pop layers ??? */
}
return NULL;
}