Skip to content

Instantly share code, notes, and snippets.

@jay
Last active December 24, 2022 20:36
Show Gist options
  • Save jay/431854a56e0079203f28 to your computer and use it in GitHub Desktop.
Save jay/431854a56e0079203f28 to your computer and use it in GitHub Desktop.
Enable HTTP2 in libcurl's Visual Studio 2010+ project files.
#!/usr/bin/env perl
=begin comment
README
This script enables HTTP2 in libcurl's Visual Studio 2010+ project files.
You'll need to modify these in-script variables for the script to work:
$curldir
$nghttp2dir
$utildir
Use --help for options to set variables.
You'll also need nghttp2 to be built using mingw32 (./configure && make).
Currently the only configurations that this script will enable HTTP2 in are
libcurl DLL configurations for Win32 that use OpenSSL. Note OpenSSL 1.0.2+ is
required for HTTP2.
Copyright (C) 2015 Jay Satiro <raysatiro@yahoo.com>
http://curl.haxx.se/docs/copyright.html
https://gist.github.com/jay/431854a56e0079203f28
=end comment
=cut
use strict;
use warnings;
use Config;
use File::Spec;
use File::Spec::Win32;
use Getopt::Long;
use IO::File;
sub strlen($) { defined($_[0]) ? length($_[0]) : 0; }
=begin comment
SUPPORTED CONFIGURATIONS
The format for specifying configs is $(Configuration)|$(Platform)
Constraints:
- Only works for the 32-bit platform:
We're working with a mingw32 built nghttp2 dll that is 32-bit.
- Only works for the configurations that make a libcurl DLL:
To handle the configs that make a libcurl LIB this script would need to be
modified to insert into curl.vcxproj as well. However in that case it may
be necessary that certain items like additional include directories not be
inserted in curlvcx.proj? It looks harmless but I haven't fully explored.
- Only works with an SSL backend that supports HTTP2:
Tested with OpenSSL and wolfSSL, other backends may support it.
=end comment
=cut
my @configs = (
"DLL Debug - DLL OpenSSL|Win32",
"DLL Release - DLL OpenSSL|Win32",
"DLL Debug - DLL OpenSSL - DLL LibSSH2|Win32",
"DLL Release - DLL OpenSSL - DLL LibSSH2|Win32",
"DLL Debug - DLL wolfSSL|Win32",
"DLL Release - DLL wolfSSL|Win32"
);
sub help() {
print
"This script enables HTTP2 in libcurl's Visual Studio 2010+ project files.\n" .
"\n" .
"You'll also need nghttp2 to be built using mingw32 (./configure && make).\n" .
"Configurations that will have HTTP2 enabled after running this script:\n" .
"\n" .
join("\n", @configs) . "\n" .
"\n" .
"The script works by inserting data to enable HTTP2 in each config.\n" .
"The script only inserts data that doesn't already exist in a config.\n" .
"It is safe to run the script multiple times on the same projects.\n" .
"\n" .
"Options:\n" .
" --curldir The full path to your curl source.\n" .
" --dryrun Show what would happen. Doesn't write any changes.\n" .
" --nghttp2dir The path to your nghttp2 source.\n" .
" If it's relative it must be relative to:\n" .
" \$curldir\\projects\\Windows\\VC??\\lib\\\n" .
#" --verbose Make the operation more talkative\n" .
"\n" .
"Use Windows-style paths for the directory options, eg C:\\foo\\bar.\n" .
"";
exit;
}
open(my $nul, ">", File::Spec->devnull()) || die "Fatal: Null device: $!\n";
##
# Set user variables
#
my $dryrun;
my $verbose;
my $curldir;
my $nghttp2dir;
GetOptions(
"curldir=s" => \$curldir,
"dryrun|dry-run" => \$dryrun,
"help|?" => \&help,
"nghttp2dir=s" => \$nghttp2dir,
"verbose" => \$verbose
) or die;
# The full path to your curl source.
$curldir = 'X:\j\curl\curl' if !defined $curldir;
# The path to your nghttp2 source.
#
# If it's relative it must be relative to $curldir\projects\Windows\VC??\lib\
#
# The directories containing libcurl.vcxproj are four deep so if you're using a
# relative path for nghttp2dir you'll have to go five back to get at the same
# level. In other words: ..\..\..\..\..\nghttp2 == $curldir\..\nghttp2
#
$nghttp2dir = '..\..\..\..\..\nghttp2' if !defined $nghttp2dir;
# The full path to a Visual Studio VC x86 bin directory. (OPTIONAL)
#
# This is needed just for VC utilities and can be any version >= 10.
#
# If you don't define this variable the script will try to auto-detect the
# location of a Visual Studio 2010+ VC x86 bin directory.
#
my $utildir; # = 'C:\Program Files (x86)\Microsoft Visual Studio 10.0\VC\bin';
# This script only works for vcxproj files, ie VC10+
my @versions = (10,11,12,14);
# The filename of the nghttp2 lib that will be created by VC utilities.
my $nghttp2libname = "nghttp2.lib";
# Each of the strings we insert must end in a semi-colon.
#
# Format [item, data]. item is matched case-insensitive.
#
# In each specified config in each specified project the script finds the item
# designators not prefixed by data and inserts.
#
# For example ["qux", "BAR;BAZ;"]
# FOO;%(Qux) becomes FOO;BAR;BAZ;%(Qux)
#
my @pairs = (
["PreprocessorDefinitions", "USE_NGHTTP2;"],
["AdditionalIncludeDirectories", "$nghttp2dir\\lib\\includes;"],
["AdditionalDependencies", "$nghttp2libname;"],
["AdditionalLibraryDirectories", "$nghttp2dir\\lib\\.libs;"]
);
##
# Check that user variables are valid
#
($curldir =~ /^[A-Z]:[\/\\]/i) ||
die "Fatal: \$curldir must be a full path (eg C:\\foo): \"$curldir\"\n";
-e $curldir || die "Fatal: \$curldir path not found: \"$curldir\"\n";
# Get an absolute location on nghttp2dir
#
# This only works because $curldir is a Windows style full path, eg C:\foo.
# Otherwise both File:Spec and File::Spec::Win32 may return a result that is
# not going to be portable for all of msys, cygwin and strawberry perl when
# we need to call native Windows utilities.
my $abs_nghttp2dir = File::Spec::Win32->rel2abs($nghttp2dir,
"$curldir\\F\\A\\K\\E\\"); # expected relative to 4 deep
# rel2abs doesn't test the path, also some are buggy
if($abs_nghttp2dir !~ /^[A-Z]:[\/\\]/i || ! -e $abs_nghttp2dir) {
die "Fatal: \$abs_nghttp2dir path not found: \"$abs_nghttp2dir\"\n";
}
if(defined $utildir) {
-e $utildir || die "Fatal: \$utildir path not found: \"$utildir\"\n";
}
else {
for(@versions) {
my $ct = $ENV{"VS$_" . "0COMNTOOLS"}; # eg VS100COMNTOOLS
if($ct && -e $ct && -e ($ct .= '..\..\VC\bin')) {
$utildir = $ct;
last;
}
}
$utildir || die "Fatal: Failed to auto-detect a path for \$utildir";
}
##
# System capture functions
#
# system_capture
# Run a command with system and capture its output.
#
# Msys: Escape switches (/slash -> //slash) so they aren't mistaken as paths.
# Use system_escsw_capture which can do that automatically if msys.
#
# Returns captured 'exitcode', 'stderr' and 'stdout' in a hashmap.
sub system_capture(@) {
# It appears that output from system won't go to stdout and stderr if they're
# reopened as in-memory files. Temporary files using undef are ok but it's
# necessary to dup them because stdout and stderr must be write-only mode.
open(my $tmp_out, "+>:crlf", undef) || die "Fatal: Failed opening temp file";
open(my $tmp_err, "+>:crlf", undef) || die "Fatal: Failed opening temp file";
open(my $tmp_exit, "+>", undef) || die "Fatal: Failed opening temp file";
# This extra fork is used because the variants of perl that run on Windows
# don't handle STDOUT/ERR save/restore in the same way.
my $pid = fork();
if(!$pid) {
STDOUT->flush();
STDERR->flush();
open(my $save_out, ">&STDOUT") || die "Fatal: Failed saving STDOUT";
open(my $save_err, ">&STDERR") || die "Fatal: Failed saving STDERR";
open(STDOUT, ">&", $tmp_out) || die "Fatal: Failed duping temp file";
open(STDERR, ">&", $tmp_err) || die "Fatal: Failed duping temp file";
# This is the only good way in 5.8 to avoid the shell reliably in Windows.
# system LIST, open2 and open3 may use the shell as a fallback even with
# multiple arguments, and capture via backticks afaict is always shell.
system { $_[0] } @_;
print $tmp_exit ($? >> 8);
STDOUT->flush();
STDERR->flush();
open(STDOUT, ">&", $save_out) || die "Fatal: Failed restoring STDOUT";
open(STDERR, ">&", $save_err) || die "Fatal: Failed restoring STDERR";
exit;
}
waitpid($pid, 0);
if($?) {
print STDERR "Fork problem, unexpected child error.\n";
print STDERR "Exit: " . ($? >> 8) . "\n";
print STDERR "Signal: " . ($? & 127) . "\n";
print STDERR "Coredump: " . (($? & 128) ? "Yes" : "No") . "\n";
die;
}
seek($tmp_out, 0, SEEK_SET);
seek($tmp_err, 0, SEEK_SET);
seek($tmp_exit, 0, SEEK_SET);
local $/;
my %ret;
# An exit code of -1 will be 255, 16777215 or 64int 72057594037927935.
$ret{exitcode} = <$tmp_exit>;
$ret{stdout} = <$tmp_out>;
$ret{stderr} = <$tmp_err>;
return \%ret;
}
# system_escsw_capture
# Wrapper around system_capture that will escape Windows switches if msys.
#
# Msys does path conversions to each argument by default. Mostly this is good
# however in the case of Windows switches (an argument that starts with a slash
# but does not have any other slash) it converts them to paths unless they're
# escaped by prepending an extra slash.
# http://www.mingw.org/wiki/Posix_path_conversion
#
# Example arg if msys: /slash
# system_capture: msys converts to C:/MinGW/msys/1.0/slash
# system_escsw_capture: we convert to //slash which msys converts to /slash
sub system_escsw_capture(@) {
my @args = @_;
if($^O eq "msys") {
for(@args) {
next if \$_ == \$args[0];
s/^(\/[^\/;]+)$/\/$1/;
}
}
return system_capture(@args);
}
# vcutil_capture
# Wrapper around system_escsw_capture that uses a custom PATH for vc util dirs.
# my $result = vcutil_capture('dumpbin', '/exports', 'foo');
{
# Use the Windows-style PATH format, eg C:\foo\bar;C:\baz\qux;
my $vcpaths = "$utildir;" .
"$utildir\\..\\..\\Common7\\IDE;"; # For mspdb???.dll
$vcpaths =~ s/^ *;//;
$vcpaths =~ s/; *$//;
if($^O eq "cygwin" || $^O eq "msys") {
my $cygdrive = ($^O eq "cygwin") ? "/cygdrive" : "";
$vcpaths =~ s/(^|;)([A-Z]):[\/\\]([^;]*)
/(($1 eq ";") ? ":" : "") . "$cygdrive\/$2\/$3"
/egix;
}
sub vcutil_capture(@) {
local $ENV{PATH} = "$vcpaths$Config{path_sep}";
return system_escsw_capture(@_);
}
}
##
# Create a lib file from the nghttp2 dll or die
#
{
print "Creating NGHTTP2 LIB file from DLL...\n\n";
my $libdir = "$abs_nghttp2dir\\lib\\.libs";
my $hint = "Have you built nghttp2 in mingw32 yet?";
# Get and sort nghttp2 dll filenames by api version
opendir(my $dh, $libdir) ||
die "Fatal: \$libdir path not found: \"$libdir\"\n$hint\n";
my $regex = qr/^libnghttp2-([0-9]+)\.dll$/i;
my @dlls =
sort { # eg libnghttp2-9.dll < libnghttp2-14.dll
my $an = ($a =~ $regex) ? $1 : 0;
my $bn = ($b =~ $regex) ? $1 : 0;
#print "\$a : $a \t\$b : $b\n";
#print "\$an : $an \t\$bn : $bn\n";
$an <=> $bn;
}
grep { $_ =~ $regex }
readdir $dh;
@dlls || die "Fatal: nghttp2 DLL not found in \"$libdir\"\n$hint\n";
closedir($dh); #important: msys2 perl 5.22 won't fork properly if $dh is open
#print "$_\n" for @dlls;
# Use the nghttp2 dll that has the most recent api version (ie last in @dlls)
my $dll = "$libdir\\" . $dlls[-1];
my $def = $dll; $def =~ s/\.dll$/.def/i;
my $lib = "$libdir\\$nghttp2libname";
=begin comment
Skip lib creation if all files are up to date.
If $lib is more or equally as recent as $def and $def is more or equally as
recent than $dll we can skip creation because this script has already been
run against the most recent build of the DLL. -M appears to only have
resolution to a second hence the equal check. Furthermore note Windows FAT
only has 2 second resolution although that's not an issue with this logic.
print "-M \$lib: " . (-M $lib) . "\n";
print "-M \$def: " . (-M $def) . "\n";
print "-M \$dll: " . (-M $dll) . "\n";
=end comment
=cut
last if -e $lib && -e $def && (-M $lib <= -M $def) && (-M $def <= -M $dll);
# Capture the most recent nghttp2 dll's export information
my $result = vcutil_capture('link', '/dump', '/exports', $dll);
if($result->{exitcode} ||
$result->{stdout} !~
/\n\n[ \t]+ordinal[ \t]+hint[ \t]+RVA[ \t]+name[ \t]*.*?\n\n
(.+?)
\n\n[ \t]+Summary\n\n
/sx) {
print STDERR "Fatal: DLL export info not found:\n";
print STDERR "$_ => $result->{$_}\n" for (sort keys %$result);
die;
}
# Parse a list of the exported functions from the export information.
# Format differs depending on whether mspdb resource was loaded during dump.
# with: 27 2 00003D80 FreeAddrInfoW = freeaddrinfo
# without: 27 2 00003D80 FreeAddrInfoW
my @exports;
push @exports, $_ for($1 =~ /^(?:[ \t]+[0-9A-F]+){3}[ \t]+(\S+)/gm);
# Create a def file from the list of the exported functions
open(my $fh, ">:crlf", $def) ||
die "Fatal: Failed to open $def : $!\n";
print $fh "EXPORTS\n\n";
print $fh "$_\n" for @exports;
close $fh;
# Create a lib file from the def file
$result = vcutil_capture('lib', "/def:$def", "/name:$dll", "/out:$lib",
'/machine:x86');
if($result->{exitcode} ||
$result->{stdout} !~ /^[ \t]*Creating library /m) {
print STDERR "Fatal: Couldn't create lib file:\n";
print STDERR "$_ => $result->{$_}\n" for (sort keys %$result);
die;
}
#print "$dll\n$lib\n$def\n";
}
##
# Update project files
#
print "Updating project files to enable NGHTTP2...\n\n";
# Everything in VERSION block is noisy, so squelch by default unless verbose.
#select $nul if !$verbose;
my @updated; # List of successfully updated projects written to disk
my $version_sep = ('=' x 79) . "\n\n";
my $project_sep = ('-' x 79) . "\n\n";
print $version_sep;
VERSION: for my $version (@versions) {
my $dir = "$curldir\\projects\\Windows\\VC$version";
my @projects = ("$dir\\lib\\libcurl.vcxproj");
PROJECT: for my $project (@projects) {
print "\n$project_sep" if \$project != \$projects[0];
print "Reading project \"$project\"";
my $content;
my $content_orig;
{
my $fh;
# msys, mingw and cygwin perl need the explicit :crlf
if(!open($fh, "<:crlf", $project)) {
print " : $!\n";
next PROJECT;
}
local $/;
$content_orig = $content = <$fh>;
}
print "\n";
CONFIG: for my $config (@configs) {
my $tag = "ItemDefinitionGroup";
print "\n[$config]";
if($content !~ /<$tag[^>]+\Q$config\E.+?<\/$tag>/s) {
print " : NOT FOUND\n-\n";
next CONFIG;
}
print "\n-\n";
my $x = $&;
PAIR: for my $pair (@pairs) {
next if !strlen($pair->[0]) || !strlen($pair->[1]);
my $item = "%(" . $pair->[0] . ")"; # eg %(qux)
my $data = $pair->[1]; # eg BAR;BAZ;
# the data must end in a semicolon followed by optional whitespace
$data =~ s/([^;\s])(\s*)$/$1;$2/;
print "$item";
if($x !~ /[;>]\s*\Q$item\E\s*[;<]/i) {
print " : NOT FOUND\n";
next PAIR;
}
print "\n";
# Insert $data if it hasn't already been inserted
# For example ["qux", "BAR;BAZ;"]
# FOO;%(Qux) becomes FOO;BAR;BAZ;%(Qux)
#
$x =~ s/([;>]\s*)
(?<!\Q$data\E)
((?i)\Q$item\E)
(\s*[;<])
/$1$data$2$3/gsx;
}
print "-\nThe config was " . ($x eq $& ? "not " : "") . "modified.\n";
$content = $` . $x . $';
#print $x;
}
print "\nThe project's in-memory copy was ";
if($content eq $content_orig) {
print "not modified (nothing inserted).\n";
next PROJECT;
}
print "modified.\n";
if(!$dryrun) {
my $backup = "$project.bak";
print "Backing up project";
if(!rename($project, $backup)) {
print " : $!\n";
next PROJECT;
}
print "\n";
print "Writing updated project";
{
my $fh;
if(!open($fh, ">:crlf", $project) ||
!(print $fh $content) ||
!close($fh)) {
print " : $!\n";
print "Restoring backup" .
(rename($backup, $project) ? "\n" : " : $!\n");
next PROJECT;
}
}
print "\n";
}
push @updated, $project;
}
}
continue {
print "\n$version_sep";
}
select STDOUT;
if(@updated) {
print "Updated projects " .
($dryrun ? "that would have been " : "") .
"written to disk:\n\n";
print "$_\n" for @updated;
}
else {
print "No projects were updated.\n";
}
print "\n" .
"This script only inserts data that doesn't already exist in a config. If a " .
"project wasn't updated and no error was shown during its parsing then that " .
"project already has HTTP2 enabled in the specified configurations.\n";
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment