view release on metacpan or  search on metacpan

Record.xs  view on Meta::CPAN

  SETERRNO(0,0);
  if( SvROK(stream) &&
      (sv=SvRV(stream)) &&
      SvTYPE(sv)==SVt_PVGV &&
      (io=GvIO(sv)) &&
      IoIFP(io) ) {
    if( (ret=recvmsg(PerlIO_fileno(IoIFP(io)), &msg, flags))<0 ) goto ret;

    SvCUR_set(buffer, ret+offset);
    *SvEND(buffer)='\0';
    SvPOK_only(buffer);

    if( (cmsgp=CMSG_FIRSTHDR(&msg))!=NULL &&
	cmsgp->cmsg_len>0 &&
	cmsgp->cmsg_level==SOL_SOCKET &&
	cmsgp->cmsg_type==SCM_RIGHTS ) {
      fdp=(int*)CMSG_DATA(cmsgp);
      nfds=(cmsgp->cmsg_len-
	    ((char*)fdp-(char*)cmsgp))/sizeof(int);
      /* warn("==> expecting %d fds -- got %d bytes, %d fds", rlim.rlim_cur, ret, nfds); */
      if( nfds>0 ) {
	/* sv is the typeglob of the filehandle here */
	svp=hv_fetch(GvHV(sv), RCV_KEY, sizeof(RCV_KEY)-1, FALSE);
	if( !(svp && SvROK(*svp) &&
	      (fd_av=(AV*)SvRV(*svp)) &&
	      SvTYPE(fd_av)==SVt_PVAV) ) {
	  /*
	   * ${*$I}{RCV_KEY}=[]
	   *   unless exists ${*$I}{RCV_KEY} and
	   *          ref(${*$I}{RCV_KEY}) eq 'ARRAY'
	   */
	  (void)hv_store(GvHV(sv), RCV_KEY, sizeof(RCV_KEY)-1,
			 newRV_inc((SV*)(fd_av=newAV())), 0);
	}
	av_extend(fd_av, av_len(fd_av)+1+nfds);
	    
	for( i=0; i<nfds; i++ ) {
	  sv=call_open_fd(fdp[i]);
	  if( sv ) av_push(fd_av, sv);
	}
      }
/*     } else { */
/*       warn("==> expecting %d fds -- got %d bytes, no CMSG", rlim.rlim_cur, ret); */
    }
  } else {
    SETERRNO(EBADF, RMS_IFI);
  }

 ret:
  if( msg.msg_control ) Safefree(msg.msg_control);
  return ret;
}

MODULE = IO::Handle::Record    PACKAGE = IO::Handle::Record   PREFIX = smh_

void
smh_peercred(s)
    PerlIO* s;
PROTOTYPE: $
PPCODE:
{
# ifdef SO_PEERCRED
  struct ucred uc;
  socklen_t uc_len=sizeof(uc);

  if( !getsockopt(PerlIO_fileno(s), SOL_SOCKET, SO_PEERCRED, &uc, &uc_len) ) {
    EXTEND(SP, 3);
    PUSHs(sv_2mortal(newSViv(uc.pid)));
    PUSHs(sv_2mortal(newSViv(uc.uid)));
    PUSHs(sv_2mortal(newSViv(uc.gid)));
  }
# else
  SETERRNO(EOPNOTSUPP, RMS_IFI);
# endif
}

void
smh_issock(s)
    PerlIO* s;
PROTOTYPE: $
PPCODE:
{
  if( fdtype(PerlIO_fileno(s))==S_IFSOCK ) {
    XSRETURN_YES;
  } else {
    XSRETURN_UNDEF;
  }
}

char *
smh_typeof(fd)
    int fd;
PROTOTYPE: $
CODE:
{
  switch(fdtype(fd)) {
  case S_IFSOCK:
    switch(socket_family(fd)) {
    case AF_UNIX:
      RETVAL=("IO::Socket::UNIX");
      break;
    case AF_INET:
      RETVAL=("IO::Socket::INET");
      break;
    case AF_INET6:
      RETVAL=("IO::Socket::INET6");
      break;
    default:
      RETVAL=("IO::Handle");
      break;
    }
    break;
  case S_IFREG:
    RETVAL=("IO::File");
    break;
  case S_IFDIR:
    RETVAL=("IO::Dir");
    break;
  case S_IFIFO:
    RETVAL=("IO::Pipe");
    break;
  default:
    RETVAL=("IO::Handle");
    break;
  }
}
OUTPUT:
RETVAL

int
smh_socket_type(s)
    int s;

    PROTOTYPE: $
    CODE:
    RETVAL=socket_type(s);
    
    OUTPUT:
    RETVAL

int