Permalink
Browse files

initial import of Win32-Symlink 0.01 from CPAN

git-cpan-module:   Win32-Symlink
git-cpan-version:  0.01
git-cpan-authorid: AUTRIJUS
git-cpan-file:     authors/id/A/AU/AUTRIJUS/Win32-Symlink-0.01.tar.gz
  • Loading branch information...
0 parents commit 8b5b6de55807fec0e2b424451e4d114b750790da Audrey Tang committed with schwern Sep 18, 2004
Showing with 329 additions and 0 deletions.
  1. +9 −0 Changes
  2. +11 −0 MANIFEST
  3. +9 −0 MANIFEST.SKIP
  4. +10 −0 META.yml
  5. +14 −0 Makefile.PL
  6. +28 −0 README
  7. +33 −0 SIGNATURE
  8. +47 −0 Symlink.pm
  9. +27 −0 Symlink.xs
  10. +105 −0 pgsymlink.c
  11. +36 −0 t/1-basic.t
9 Changes
@@ -0,0 +1,9 @@
+----------------------------------------------------------------------
+r7676: | 2004-09-18T20:15:51.075244Z
+
+This be 0.01.
+----------------------------------------------------------------------
+r7674: autrijus | 2004-09-18T19:41:59.869858Z
+
+* Initial checkin of Win32::Symlink
+----------------------------------------------------------------------
11 MANIFEST
@@ -0,0 +1,11 @@
+pgsymlink.c
+Changes
+Symlink.pm
+Symlink.xs
+Makefile.PL
+MANIFEST
+MANIFEST.SKIP
+README
+SIGNATURE
+t/1-basic.t
+META.yml Module meta-data (added by MakeMaker)
9 MANIFEST.SKIP
@@ -0,0 +1,9 @@
+#defaults
+^MANIFEST.bak$
+^Makefile$
+^Makefile.old$
+^blib/
+^pm_to_blib$
+^blibdirs$
+^Symlink.(?!pm$|xs$).*$
+^pgsymlink.(?!c$).*$
10 META.yml
@@ -0,0 +1,10 @@
+# http://module-build.sourceforge.net/META-spec.html
+#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
+name: Win32-Symlink
+version: 0.01
+version_from: Symlink.pm
+installdirs: site
+requires:
+
+distribution_type: module
+generated_by: ExtUtils::MakeMaker version 6.21
14 Makefile.PL
@@ -0,0 +1,14 @@
+#!/usr/bin/perl
+
+use Config;
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+ 'NAME' => 'Win32::Symlink',
+ 'VERSION_FROM' => 'Symlink.pm',
+ 'AUTHOR' => 'Autrijus Tang <autrijus@autrijus.org>',
+ 'ABSTRACT' => 'Symbolic links on Win32',
+ (ExtUtils::MakeMaker->VERSION >= 6.21) ? (SIGN => 1) : ()
+);
+
+1;
28 README
@@ -0,0 +1,28 @@
+This is the README file for Win32::Symlink, a module implementing
+symbolic links on windows.
+
+* Installation
+
+Win32::Symlink uses the standard perl module install process:
+
+cpansign -v # see SIGNATURE for details
+perl Makefile.PL
+make
+make test
+make install
+
+* Copyright
+
+Copyright 2004 by Autrijus Tang <autrijus@autrijus.org>.
+
+All rights reserved. You can redistribute and/or modify
+this bundle under the same terms as Perl itself.
+
+See <http://www.perl.com/perl/misc/Artistic.html>.
+
+# Local variables:
+# c-indentation-style: bsd
+# c-basic-offset: 4
+# indent-tabs-mode: nil
+# End:
+# vim: expandtab shiftwidth=4:
33 SIGNATURE
@@ -0,0 +1,33 @@
+This file contains message digests of all files listed in MANIFEST,
+signed via the Module::Signature module, version 0.38.
+
+To verify the content in this distribution, first make sure you have
+Module::Signature installed, then type:
+
+ % cpansign -v
+
+It would check each file's integrity, as well as the signature's
+validity. If "==> Signature verified OK! <==" is not displayed,
+the distribution may already have been compromised, and you should
+not run its Makefile.PL or Build.PL.
+
+-----BEGIN PGP SIGNED MESSAGE-----
+Hash: SHA1
+
+SHA1 1e3e2eba24956556729d0b1617727fd49761e4e7 Changes
+SHA1 492998085140dadede823affd76d8ffc78e77174 MANIFEST
+SHA1 bcbcf72c19a6fc86f07fd523d9b6e773e5b9247f MANIFEST.SKIP
+SHA1 28da192eaa849010200f0e85eb69e9e1a517602d META.yml
+SHA1 b9658d16261c77f0158b091361c68522fd681d92 Makefile.PL
+SHA1 098af239a2c163482b5d1e99f574bbfc49822901 README
+SHA1 6ad565e51bff0a2f2b6fea11edb8e07a30763934 Symlink.pm
+SHA1 3e07cc67859beba9fd19731e271d9abec2b9f71e Symlink.xs
+SHA1 cf613d720ce01e4c37178d89fb36e952a268a4fe pgsymlink.c
+SHA1 c8023964246f90282f0c9ee17e3d54012a3b8dcd t/1-basic.t
+-----BEGIN PGP SIGNATURE-----
+Version: GnuPG v1.2.3 (FreeBSD)
+
+iD8DBQFBTJmAtLPdNzw1AaARAm0NAJ0USg1MrdvUFLcwhDy/3XAoFNSkxQCdEigP
+bbhkN1OX7u1/HZcjBTB6cAg=
+=G/2S
+-----END PGP SIGNATURE-----
47 Symlink.pm
@@ -0,0 +1,47 @@
+package Win32::Symlink;
+
+use strict;
+use vars qw($VERSION @ISA);
+use DynaLoader;
+
+@ISA = qw(DynaLoader);
+$VERSION = '0.01';
+
+__PACKAGE__->bootstrap($VERSION);
+
+1;
+
+__END__
+
+=head1 NAME
+
+Win32::Symlink - Symlink support on Windows
+
+=head1 VERSION
+
+This document describes version 0.01 of Win32::Symlink, released
+September 19, 2004.
+
+=head1 SYNOPSIS
+
+ use Win32::Symlink;
+ symlink( 'from' => 'to' );
+
+=head1 DESCRIPTION
+
+=head1 NOTES
+
+=head1 AUTHORS
+
+Autrijus Tang E<lt>autrijus@autrijus.orgE<gt>
+
+=head1 COPYRIGHT
+
+Copyright 2004 by Autrijus Tang E<lt>autrijus@autrijus.orgE<gt>.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+See L<http://www.perl.com/perl/misc/Artistic.html>
+
+=cut
27 Symlink.xs
@@ -0,0 +1,27 @@
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+#ifdef __cplusplus
+}
+#endif
+
+#include "pgsymlink.c"
+
+MODULE = Win32::Symlink PACKAGE = Win32::Symlink
+
+int
+symlink(oldpath, newpath)
+ const char * oldpath
+ const char * newpath
+ CODE:
+ if (pgsymlink(oldpath, newpath) == -1) {
+ RETVAL = 0;
+ }
+ else {
+ RETVAL = 1;
+ }
+ OUTPUT:
+ RETVAL
105 pgsymlink.c
@@ -0,0 +1,105 @@
+/*
+ * Source: http://www.mail-archive.com/pgsql-committers@postgresql.org/msg03912.html
+ */
+
+#include <windows.h>
+#include <winioctl.h>
+#include <stdio.h>
+
+/*
+ * pgsymlink support:
+ *
+ * This struct is a replacement for REPARSE_DATA_BUFFER which is defined in VC6 winnt.h
+ * but omitted in later SDK functions.
+ * We only need the SymbolicLinkReparseBuffer part of the original struct's union.
+ */
+typedef struct
+{
+ DWORD ReparseTag;
+ WORD ReparseDataLength;
+ WORD Reserved;
+ /* SymbolicLinkReparseBuffer */
+ WORD SubstituteNameOffset;
+ WORD SubstituteNameLength;
+ WORD PrintNameOffset;
+ WORD PrintNameLength;
+ WCHAR PathBuffer[1];
+}
+REPARSE_JUNCTION_DATA_BUFFER;
+
+#define REPARSE_JUNCTION_DATA_BUFFER_HEADER_SIZE \
+ FIELD_OFFSET(REPARSE_JUNCTION_DATA_BUFFER, SubstituteNameOffset)
+
+/*
+ * pgsymlink - uses Win32 junction points
+ *
+ * For reference: http://www.codeproject.com/w2k/junctionpoints.asp
+ */
+int
+pgsymlink(const char *oldpath, const char *newpath)
+{
+ HANDLE dirhandle;
+ DWORD len;
+ char nativeTarget[MAX_PATH];
+ char *p = nativeTarget;
+ char buffer[MAX_PATH*sizeof(WCHAR) + sizeof(REPARSE_JUNCTION_DATA_BUFFER)];
+ REPARSE_JUNCTION_DATA_BUFFER *reparseBuf = (REPARSE_JUNCTION_DATA_BUFFER*)buffer;
+
+ CreateDirectory(newpath, 0);
+ dirhandle = CreateFile(newpath, GENERIC_READ | GENERIC_WRITE,
+ 0, 0, OPEN_EXISTING,
+ FILE_FLAG_OPEN_REPARSE_POINT | FILE_FLAG_BACKUP_SEMANTICS, 0);
+
+ if (dirhandle == INVALID_HANDLE_VALUE)
+ return -1;
+
+ /* make sure we have an unparsed native win32 path */
+ if (memcmp("\\??\\", oldpath, 4))
+ sprintf(nativeTarget, "\\??\\%s", oldpath);
+ else
+ strcpy(nativeTarget, oldpath);
+
+ while ((p = strchr(p, '/')) != 0)
+ *p++ = '\\';
+
+ len = strlen(nativeTarget) * sizeof(WCHAR);
+ reparseBuf->ReparseTag = IO_REPARSE_TAG_MOUNT_POINT;
+ reparseBuf->ReparseDataLength = (unsigned short)(len + 12);
+ reparseBuf->Reserved = 0;
+ reparseBuf->SubstituteNameOffset = 0;
+ reparseBuf->SubstituteNameLength = (unsigned short)(len);
+ reparseBuf->PrintNameOffset = (unsigned short)(len+sizeof(WCHAR));
+ reparseBuf->PrintNameLength = 0;
+ MultiByteToWideChar(CP_ACP, 0, nativeTarget, -1,
+ reparseBuf->PathBuffer, MAX_PATH);
+
+ /*
+ * FSCTL_SET_REPARSE_POINT is coded differently depending on SDK version;
+ * we use our own definition
+ */
+ if (!DeviceIoControl(dirhandle,
+ CTL_CODE(FILE_DEVICE_FILE_SYSTEM, 41, METHOD_BUFFERED, FILE_ANY_ACCESS),
+ reparseBuf,
+ reparseBuf->ReparseDataLength + REPARSE_JUNCTION_DATA_BUFFER_HEADER_SIZE,
+ 0, 0, &len, 0))
+ {
+ LPSTR msg;
+
+ errno=0;
+ FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_FROM_SYSTEM,
+ NULL, GetLastError(),
+ MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),
+ (LPSTR)&msg, 0, NULL );
+ Perl_warn(aTHX_ "Error setting junction for %s: %s", nativeTarget, msg);
+
+ LocalFree(msg);
+
+ CloseHandle(dirhandle);
+ RemoveDirectory(newpath);
+ return -1;
+ }
+
+ CloseHandle(dirhandle);
+
+ return 0;
+}
36 t/1-basic.t
@@ -0,0 +1,36 @@
+use strict;
+use Test;
+BEGIN { plan tests => 3 };
+
+use FindBin;
+use File::Spec;
+use Win32::Symlink;
+
+ok(Win32::Symlink->VERSION);
+
+my $foo = File::Spec->catdir($FindBin::Bin, 'foo');
+mkdir $foo or die $!;
+
+my $has_symlink = eval { Win32::Symlink::symlink( $foo => "$foo.new" ) };
+
+if (!$has_symlink) {
+ skip(1);
+ skip(1);
+ exit;
+}
+
+ok(-d "$foo.new");
+
+open FH, "> ".File::Spec->catfile($foo, 'bar') or die $!;
+print FH "TEST";
+close FH;
+
+open FH, "< ".File::Spec->catfile("$foo.new", 'bar') or die $!;
+ok(scalar <FH>, "TEST");
+close FH;
+
+END {
+ unlink File::Spec->catfile($foo, 'bar');
+ rmdir "$foo.new";
+ rmdir $foo;
+}

0 comments on commit 8b5b6de

Please sign in to comment.