Newer
Older
NetAddr-IP / Lite / Util / xs_include / miniSocket.inc
@Michael Robinton Michael Robinton on 21 Oct 2014 4 KB Import of MIKER/NetAddr-IP-4.020 from CPAN.
  1.  
  2. # This file is excerpted from perl-5.8.0/ext/Socket/Socket.xs and
  3. # modified slightly so that it compiles on older versions of perl/gcc
  4. #
  5. # 3/28/06 version 1.78 of Socket.xs, included in perl 5.9.3
  6. # is 100% compatible with this version
  7. #
  8. # Copyright 2003 - 2006, Michael Robinton <michael@bizsystems.com
  9. #
  10. # This program is free software; you can redistribute it and/or modify
  11. # it under the same license and provisions as perl.
  12. #
  13.  
  14. #ifndef Newx
  15. #define Newx(v,n,t) New(1138,v,n,t)
  16. #endif
  17.  
  18. #########################################################################
  19. # Perl Kit, Version 5
  20. #
  21. # Copyright 1989-2002, Larry Wall
  22. # All rights reserved.
  23. #
  24. # This program is free software; you can redistribute it and/or modify
  25. # it under the terms of either:
  26. #
  27. # a) the GNU General Public License as published by the Free
  28. # Software Foundation; either version 1, or (at your option) any
  29. # later version, or
  30. #
  31. # b) the "Artistic License" which comes with this Kit.
  32. #
  33. # This program is distributed in the hope that it will be useful,
  34. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  35. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either
  36. # the GNU General Public License or the Artistic License for more details.
  37. #
  38. # You should have received a copy of the Artistic License with this
  39. # Kit, in the file named "Artistic". If not, I'll be glad to provide one.
  40. #
  41. # You should also have received a copy of the GNU General Public License
  42. # along with this program in the file named "Copying". If not, write to the
  43. # Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
  44. # 02111-1307, USA or visit their web page on the internet at
  45. # http://www.gnu.org/copyleft/gpl.html.
  46. #
  47. # For those of you that choose to use the GNU General Public License,
  48. # my interpretation of the GNU General Public License is that no Perl
  49. # script falls under the terms of the GPL unless you explicitly put
  50. # said script under the terms of the GPL yourself. Furthermore, any
  51. # object code linked with perl does not automatically fall under the
  52. # terms of the GPL, provided such object code only adds definitions
  53. # of subroutines and variables, and does not otherwise impair the
  54. # resulting interpreter from executing any standard Perl script. I
  55. # consider linking in C subroutines in this manner to be the moral
  56. # equivalent of defining subroutines in the Perl language itself. You
  57. # may sell such an object file as proprietary provided that you provide
  58. # or offer to provide the Perl source, as specified by the GNU General
  59. # Public License. (This is merely an alternate way of specifying input
  60. # to the program.) You may also sell a binary produced by the dumping of
  61. # a running Perl script that belongs to you, provided that you provide or
  62. # offer to provide the Perl source as specified by the GPL. (The
  63. # fact that a Perl interpreter and your code are in the same binary file
  64. # is, in this case, a form of mere aggregation.) This is my interpretation
  65. # of the GPL. If you still have concerns or difficulties understanding
  66. # my intent, feel free to contact me. Of course, the Artistic License
  67. # spells all this out for your protection, so you may prefer to use that.
  68. #
  69.  
  70. #include <netdb.h>
  71.  
  72. void
  73. yinet_aton(host)
  74. char * host
  75. CODE:
  76. {
  77. struct in_addr ip_address;
  78. struct hostent * phe;
  79. int ok =
  80. (host != NULL) &&
  81. (*host != '\0') &&
  82. inet_aton(host, &ip_address);
  83.  
  84. if (!ok && (phe = gethostbyname(host))) {
  85. Copy( phe->h_addr, &ip_address, phe->h_length, char );
  86. ok = 1;
  87. }
  88.  
  89. ST(0) = sv_newmortal();
  90. if (ok)
  91. sv_setpvn( ST(0), (char *)&ip_address, sizeof ip_address );
  92. }
  93.  
  94. void
  95. inet_ntoa(ip_address_sv)
  96. SV * ip_address_sv
  97. CODE:
  98. {
  99. STRLEN addrlen;
  100. struct in_addr addr;
  101. char * addr_str;
  102. char * ip_address;
  103. # sigh.... these lines fail on older perl/gcc combinations
  104. # if (DO_UTF8(ip_address_sv) && !sv_utf8_downgrade(ip_address_sv, 1))
  105. # croak("Wide character in Socket::inet_ntoa");
  106. # ip_address = SvPVbyte(ip_address_sv, addrlen);
  107. ip_address = SvPV(ip_address_sv,addrlen);
  108. if (addrlen == sizeof(addr) || addrlen == 4)
  109. addr.s_addr =
  110. (ip_address[0] & 0xFF) << 24 |
  111. (ip_address[1] & 0xFF) << 16 |
  112. (ip_address[2] & 0xFF) << 8 |
  113. (ip_address[3] & 0xFF);
  114. else
  115. croak("Bad arg length for %s, length is %d, should be %d",
  116. "NetAddr::IP::Util::inet_ntoa",
  117. addrlen, sizeof(addr));
  118. /* We could use inet_ntoa() but that is broken
  119. * in HP-UX + GCC + 64bitint (returns "0.0.0.0"),
  120. * so let's use this sprintf() workaround everywhere.
  121. * This is also more threadsafe than using inet_ntoa(). */
  122. Newx(addr_str, 4 * 3 + 3 + 1, char); /* IPv6? */
  123. sprintf(addr_str, "%d.%d.%d.%d",
  124. ((addr.s_addr >> 24) & 0xFF),
  125. ((addr.s_addr >> 16) & 0xFF),
  126. ((addr.s_addr >> 8) & 0xFF),
  127. ( addr.s_addr & 0xFF));
  128. ST(0) = sv_2mortal(newSVpvn(addr_str, strlen(addr_str)));
  129. Safefree(addr_str);
  130. }