blog.gbacon.com

Net::OpenID::Consumer failure: naive verify failed network

2011-05-23T00:00:00-05:00

I was working on adding OpenID to a Mojolicious webapp on DotCloud—thanks to helpful sample code from Henry that Net::OpenID::Consumer-1.03—and hit a strange failure. The call to handle_server_response was failing in the error callback with a generic error code naive_verify_failed_network.

Going source diving, I learned slightly more about this particular error: “Could not contact provider to verify signature.” Details, man; I’m a fact finder! The good news is this particular error code is returned in a single place, at line 849:

return $self->_fail("naive_verify_failed_network")
    unless $res && $res->is_success;

Here $res is an HTTP::Response instance returned from the request method on LWPx::ParanoidAgent. HTTP::Response has another helpful method:

$r->error_as_HTML

Returns a string containing a complete HTML document indicating what error occurred. This method should only be called when $r->is_error is TRUE.

So I first do a little plumbing for my Mojolicious::Lite prototype.

my $log = app->log;
$SIG{"__WARN__"} = sub {
  unshift @_, $log;
  goto $log->can("warn");
};

Grungy, yes, but it’s a quick adaptation of a nicer technique for debugging non-lite apps.

Just before return $self->_fail ..., I added

if ($res && $res->is_error) {
    warn $res->error_as_HTML;
}

After retrying the OpenID verification, my log contained

501 Attempt to reload LWPx/Protocol/https_paranoid.pm aborted

but running grep -rl Attempt\ to\ reload ~/perl5/lib produced no hits.

Same with Google.

Chopping the specific bits out of my query, leaving “Attempt to reload” aborted, the first hit was a perldiag entry.

Attempt to reload %s aborted.

(F) You tried to load a file with use or require that failed to compile once already. Perl will not try to compile this file again unless you delete its entry from %INC. See require in perlfunc and %INC in perlvar.

Okay, so let’s see why the module is unhappy:

$ perl -Iperl5 -MLWPx::Protocol::https_paranoid -de 0

Loading DB routines from perl5db.pl version 1.33
Editor support available.

Enter h or `h h' for help, or `man perldebug' for more help.

Can't locate IO/Socket/SSL.pm in @INC at ...

Hidden dependency! IO::Socket::SSL is good to have with Mojolicious, so I edited my Makefile.PL to include

requires "IO::Socket::SSL" => '1.43';

A sequence of perl Makefile.PL; make; dotcloud push ... gave me successful OpenID verification! As an extra goodie thanks to DotCloud, instead of a Cache::File instead, my code uses Redis in the cache parameter to Net::OpenID::Consumer’s constructor.

Net::OpenID::Consumer failure: naive verify failed network was originally published by Greg Bacon at blog.gbacon.com on May 23, 2011.

Considering a gas-powered standby generator

2011-04-29T00:00:00-05:00

I’ve been wearing my Bo Williams Risk Analysis™ cap a fair amount for the past couple of days, and this post started life as a comment on his post Friday miscellanea, post-Alabama tornado super-outbreak edition.

Our house has gas heat and a gas set in the fireplace. I’ve been letting the latter slide in a state of disrepair. I recognize and accept this BWRA™ Demerit. It will be ready before winter 2011, which will mean redundant sources of heat. You ought to see my related GTD project list!

The option is obvious now, but it took a conversation with my dad to learn about permanent standby generators that run on natural gas and periodically test themselves. I priced them online and may be able to purchase a unit that would power most of my house, perhaps in staggered operation for heavy loads such as HVAC and dryer, for around $5k with no headaches of managing a gasoline reserve or just–in–time fuel purchases.

The last week–long outage in the area was nearly forty years ago, but sidestepping even hours–long outages due to storms, ice on power lines, drunks hitting poles, and so on is awfully appealing too. I emptied the refrigerator and freezer, and temperatures in the Huntsville area are projected to be mild. My one power–related worry is my 55–gallon cichlid tank. I turned on a battery–powered air pump, but that’s about the best I could do. I think I was a week overdue for a water change when we lost power, so staying on top of aquarium chores in the future will help there too, assuming optimistically that these hardy critters make it.

Extracting comma-separated integers with Perl

2011-03-01T00:00:00-06:00

A friend writes asking which of

my @data = ( $data =~ m|(-?\d+),(-?\d+),(\-?\d+)\r| );

($data) = (split "\r", $data);
my @data = split ',', $data;

would be better for extracting integers from a line of input, and my reply is below.

The best approach depends on a few factors. Who generates the data you’re processing? How much slop in the input format do you need to accommodate? How flexible do you need to be with respect to future changes in the input, e.g., extra fields, different types, and so on?

The CR (\r) in your input is a red flag. Are you running on a Unix platform with input generated on Windows? Can you be more specific about “possibly some other stuff” after the comma-separated numbers?

Perl’s $/ special variable can handle oddball line endings. Its default value varies with what makes sense for the current platform: e.g., \n on Unix and \r\n on Windows. Macs introduce another twist (see Newlines in the perlport documentation), but I assume you’re not using that platform.

On Windows for files opened in text mode (the default), the C library silently transforms CR followed by LF into LF, so if this matches your setup, I’m surprised you’re seeing the \r at all.

Say your input is plain text generated on Windows, and you’re running on Linux. Then you’d process it with code of the form

$/ = "\r\n";
 
while (defined($data = <>)) {
    chomp;
    ...;
}

Remember that chomp removes the value of $/ from the end of the target.

As for extracting the data, Randal Schwartz (author of Learning Perl, a.k.a. the llama book) has a rule of thumb:

Use capturing or m//g when you know what you want to keep.

Use split when you know what you want to throw away.

I first saw this useful guideline in Regular Expression Mastery by Mark Dominus.

If this is a quick-and-dirty utility, I’d be inclined to write

@data = split /\s*,\s*/, $data;

This allows for and removes any whitespace around the commas.

If it’s important to nail down the format (maybe as a sanity check that you’re in the section of the config file where you think you are), you could write

if ($data =~ /^\s*(-?\d+)\s*,\s*(-?\d+)\s*,\s*(-?\d+)\s*$/) {
    my($x,$y,$z) = ($1,$2,$3);
    ...;
}
else {
    die "$0: $ARGV:$.: unexpected format";
}

Note the use of $1 and friends inside the conditional only. Always, always, always protect uses of capture variables with conditionals.

The pattern is just at the annoyance threshold of repetition and illegibility. Perl version 5.10 opens up nice possibilities with named capture buffers:

#! /usr/bin/env perl
 
use strict;
use warnings;
 
use 5.10.0;
 
my $record = qr/
    ^
    (?&ws)
    (?<num>(?&n)) (?&sep) (?<num>(?&n)) (?&sep) (?<num>(?&n))
    (?&ws)
    $
 
    (?(DEFINE)
        (?<n> -? \d+)
        (?<ws> \s* )
        (?<sep> (?&ws) , (?&ws))
    )
/x;
 
while (<DATA>) {
    if (/$record/) {
        my($x,$y,$z) = @{ $-{num} };
        print "got: x=$x, y=$y, z=$z\n";
    }
    else {
        warn "$0: line $.: no match\n";
    }
}
 
__DATA__
1,2,3
4,5,6
7,8

Its output:

got: x=1, y=2, z=3
got: x=4, y=5, z=6
./prog: line 3: no match

Notice its use of the special %- hash that records all captures named “num” in this case. With (DEFINE), subpatterns get meaningful names, and the /x modifier allow for judicious use of whitespace inside the pattern.

Extracting comma-separated integers with Perl was originally published by Greg Bacon at blog.gbacon.com on March 01, 2011.

Checkers game-over in Haskell

2011-01-01T00:00:00-06:00

The programming subreddit recently had a discussion about testing a checkers board for game-over. I wondered how specifying the rules for legal moves would look with Haskell’s pattern matching, and this post is a study of that technique. In fact, you can run yourself. Copy-and-paste the post body to a file named Checkers.lhs to get a working program!

The game is American checkers or English draughts, played on an eight–by–eight checkerboard, of all surfaces.

> {-# LANGUAGE ViewPatterns #-}
> module Checkers where
> import Data.Char (toLower,toUpper)
> import Data.List (tails,transpose)
> import Test.HUnit
> data Board = Board [String] deriving (Show)
> size :: Int
> size = 8

For a rough idea of the punchline, I was hoping for code along the lines of

move ('w':' ':_)     = 1
move ('W':' ':_)     = 1
move (' ':'W':_)     = 1
move ('w':'b':' ':_) = 1
move ('w':'B':' ':_) = 1
move ('W':'b':' ':_) = 1
move ('W':'B':' ':_) = 1
move (' ':'b':'W':_) = 1
move (' ':'B':'W':_) = 1
move _ = 0

and eventually

> gameOver :: Board -> Bool
> gameOver b = blueMoves b == 0 || whiteMoves b == 0

The OP on reddit chose white and blue for the sides’ colors, and above we have more–or–less declarative rules for legal white moves. A pawn or king (w and W respectively) can move to an empty space before it. Kings are special in that they can move backwards. The list ends with legal jumps, and everything else is invalid.

The code is repetitive, but I’ll clean that up later.

An immediate problem is the patterns are linear, but all legal moves in checkers are along diagonals. I kicked around ideas such as using IArray or nasty double-applications of !!. Then I realized I could rotate the board by 45° with a shear, a transposition, and removal of placeholders.

-- diagonals with positive slopes
posdiags = map reverse . filter used . transpose . map shear . zip [0..]
  where shear (i,s) = (replicate i              '#') ++ s ++
                      (replicate (k - size - i) '#')
        k = 2 * size - 1
        used = not . all (`elem` "#.")

Getting the other diagonals is similar, but again brings too much repetition.

negdiags = map reverse . filter used . transpose . map shear . zip [0..]
  where shear (i,s) = (replicate (k - size - i) '#') ++ s ++
                      (replicate i              '#')
        k = 2 * size - 1
        used = not . all (`elem` "#.")</pre></div></div>

Having Board values to play with is trivial:

> board :: String -> Board
> board s = Board $ go s
>   where go [] = []
>         go xs = let (a,bs) = splitAt size xs
>                 in a : go bs

It chops one long string into rows, but with Haskell’s usually–awkward multiline strings, it’s not so bad. For example

startBoard =
  ".b.b.b.b\
  \b.b.b.b.\
  \.b.b.b.b\
  \ . . . .\
  \. . . . \
  \w.w.w.w.\
  \.w.w.w.w\
  \w.w.w.w."

An early cut at blueMoves and reducing the repetition in the rules for moves was

blueMoves :: Board -> Int
blueMoves (diagonals -> (p,n)) =
  sum $ map move $ concatMap tails $ p ++ n
  where move ( b :' ':_) | b `elem` "Bb" = 1
        move (' ':'B':_) = 1
        move ('b': w :' ':_) | w `elem` "Ww" = 1
        move (' ': w :'B':_) | w `elem` "Ww" = 1
        move _ = 0

Sticking with the theme of repetition, whiteMoves is nearly identical with little breadcrumbs of differences. That was all good because I wanted to have a testsuite before I started refactoring.

tests :: Test
tests = test
  [ assertEqual "white must have piece to move"
      0 (nw ".b.b.b.b\
            \b.b.b.b.\
            \.b.b.b.b\
            \ . . . .\
            \. . . . \
            \ . . . .\
            \. . . . \
            \ . . . .")
  ]
  where nw = whiteMoves . board

Not bad for a start, but each testcase will have a dual for the other side—way too much copy-and-paste.

*Checkers> runTestTT tests
Loading package HUnit-1.2.2.1 ... linking ... done.
Cases: 1  Tried: 1  Errors: 0  Failures: 0
Counts {cases = 1, tried = 1, errors = 0, failures = 0}

Whee!

To wring out the duplication in the code for each side’s moves, I considered using Template Haskell—a cousin of Lisp macros for Haskell. I decided to push lexical closures as far as I could, and the result is below.

> blueMoves, whiteMoves :: Board -> Int
> [blueMoves, whiteMoves] =
>   let blueOrder = id  -- diagonals emerge in blue’s perspective
>       whiteOrder = map reverse
>       count (direction,side) (diagonals -> ds) =
>         sum $ map sideCanMove $ concatMap tails $ direction $ ds
>         where sideCanMove ( p :' ':_)     | same p = 1
>               sideCanMove (' ': k :_)     | king k = 1
>               sideCanMove ( p : o :' ':_) | same p && opponent o = 1
>               sideCanMove (' ': o : k :_) | king k && opponent o = 1
>               sideCanMove _ = 0
>               same p     = piece p && toLower p == toLower side
>               opponent p = piece p && toLower p /= toLower side
>               king p     =  same p &&         p == toUpper side
>               piece p    = p `elem` "BbWw"  -- filter empty spaces
>   in map count [ (blueOrder, 'b'), (whiteOrder, 'w') ]</pre></div></div>

The code in count (notice the view pattern?) is a skeleton to be customized for the blue side and the white side, and it distills the repeated code. The definition of sideCanMove generalizes the rules for legal moves on either side. We have to reverse the diagonals to make them usable on the white side.

To get both sets of diagonals, the only difference is how to shear the board: bottom-away for positive slopes and top-away for negative.

> -- positive slopes slice from NW to SE
> -- negative slopes slice from SW to NE
> -- both extend in blue’s direction (north-to-south)
> diagonals :: Board -> [String]
> diagonals (Board rows) = positiveSlopes rows ++ negativeSlopes rows
>   where positiveSlopes = go $ \(i,xs) -> (i, k - size - i, xs)
>         negativeSlopes = go $ \(i,xs) -> (k - size - i, i, xs)
>         k = 2 * size - 1
>         used = not . all ignored
>         go order = filter (not . null)
>                  . map (filter $ not . ignored)
>                  . transpose
>                  . map (shear . order)
>                  . zip [0..]
>         ignored = (`elem` "#.")
>         shear (l,r,s) = (replicate l '#') ++ s ++ (replicate r '#')

Finally come the tests that I added as I went. To factor out duplication, each board becomes two testcases. The first is as–is, and the same condition should hold for the other side. See the definition of invert in the where clause.

I had hoped for a more elegant result, but it was an interesting exercise and a fun problem!

> tests :: Test
> tests = test $ concat
>   [ checkMoves "must have piece to move"
>       0 ".b.b.b.b\
>         \b.b.b.b.\
>         \.b.b.b.b\
>         \ . . . .\
>         \. . . . \
>         \ . . . .\
>         \. . . . \
>         \ . . . ."
>   , checkMoves "one move"
>       1 ". . . . \
>         \ . . . .\
>         \. . . . \
>         \ . . . .\
>         \. . . . \
>         \ . . . .\
>         \. . . . \
>         \w. . . ."
>   , checkMoves "one king move"
>       1 ". . . . \
>         \ . . . .\
>         \. . . . \
>         \ . . . .\
>         \. . . . \
>         \ . . . .\
>         \. . . . \
>         \W. . . ."
>   , checkMoves "two moves"
>       2 ". . . . \
>         \ . . . .\
>         \. . . . \
>         \ . . . .\
>         \. . . . \
>         \ . . . .\
>         \. . . . \
>         \ .w. . ."
>   , checkMoves "king can move back from end"
>       2 ". . .W. \
>         \ . . . .\
>         \. . . . \
>         \ . . . .\
>         \. . . . \
>         \ . . . .\
>         \. . . . \
>         \ . . . ."
>   , checkMoves "can jump opponent pawn"
>       1 ". . . . \
>         \ . . . .\
>         \. . . . \
>         \ . . . .\
>         \. . . . \
>         \ . . . .\
>         \.b. . . \
>         \w. . . ."
>   , checkMoves "can't jump blocked opponent"
>       0 ". . . . \
>         \ . . . .\
>         \. . . . \
>         \ . . . .\
>         \. . . . \
>         \ .b. . .\
>         \.b. . . \
>         \w. . . ."
>   , checkMoves "can jump opponent king"
>       1 ". . . . \
>         \ . . . .\
>         \. . . . \
>         \ . . . .\
>         \. . . . \
>         \ . . . .\
>         \.B. . . \
>         \w. . . ."
>   , checkMoves "king can jump trailing opponent"
>       1 ". . . .W\
>         \ . . .b.\
>         \. . . . \
>         \ . . . .\
>         \. . . . \
>         \ . . . .\
>         \. . . . \
>         \ . . . ."
>   , checkMoves "king can't jump protected opponent"
>       0 ". . . .W\
>         \ . . .b.\
>         \. . .b. \
>         \ . . . .\
>         \. . . . \
>         \ . . . .\
>         \. . . . \
>         \ . . . ."
>   , checkMoves "king can't jump onto own piece"
>       1 ". . . .W\
>         \ . . .b.\
>         \. . .w. \
>         \ . . . .\
>         \. . . . \
>         \ . . . .\
>         \. . . . \
>         \ . . . ."
>   , checkMoves "king has four moves"
>       4 ". . . . \
>         \ . . . .\
>         \. . . . \
>         \ . .W. .\
>         \. . . . \
>         \ . . . .\
>         \. . . . \
>         \ . . . ."
>   , checkMoves "cannot displace opponent on king row"
>       0 ". . .b.b\
>         \ . . .w.\
>         \. . . . \
>         \ . . . .\
>         \. . . . \
>         \ . . . .\
>         \. . . . \
>         \ . . . ."
>   ]
>   where nw = whiteMoves . board
>         nb = blueMoves  . board
>         checkMoves name expect b =
>           [ assertEqual ("white: " ++ name) expect (nw b)
>           , assertEqual ("blue: "  ++ name) expect (nb $ invert b)
>           ]
>         invert = reverse . replace [('W','B'), ('w','b'), ('B','W'), ('b','w')]
>         replace tbl = map (\c -> maybe c id $ lookup c tbl)

Checkers game-over in Haskell was originally published by Greg Bacon at blog.gbacon.com on January 01, 2011.

Perl: conditional use and scope

2010-03-01T00:00:00-06:00

A reader asks

If I conditionally load a perl module, do those module variables get passed to the whole perl script?
if ( some_test ) {
  use "perlmodule_001";
}
else {
  use "perlmodule_002";
}
Are the elements of either perl module available outside the if statement?

The main program from the question has a syntax error:

syntax error at prog0 line 2, near "use "perlmodule_001""

Perl’s documentation for use explains:

use Module
Imports some semantics into the current package from the named module, generally by aliasing certain subroutine or variable names into your package. It is exactly equivalent to
BEGIN { require Module; Module->import( LIST ); }
except that Module must be a bareword.

Note the bareword constraint at the end: the compiler doesn’t like the double quotes around the argument to use. Our friend was likely thinking of the older require operator that does accept strings and arbitrary expressions in general.

Say we have two modules with alternative definitions of $Foo and $Bar:

package Perlmodule_001;

use Exporter 'import';
our @EXPORT = qw/ $Foo $Bar /;
our $Foo = 'apple';
our $Bar = 'orange';

1;

and

package Perlmodule_002;

use Exporter 'import';
our @EXPORT = qw/ $Foo $Bar /;
our $Foo = 42;
our $Bar = 'w00t!';

1;

Note the use of Perlmodule_001, for example, rather than perlmodule_001: the perlmodlib documentation notes, “Perl informally reserves lowercase module names for pragma modules like integer and strict.”

Consider the following simple driver:

#! /usr/bin/perl

use warnings;
use strict;

if (@ARGV && $ARGV[0] eq "two") {
    use Perlmodule_002;
}
else {
    use Perlmodule_001;
}

sub maybeUndef {
    defined $_[0] ? $_[0] : "<undefined>";
    # got 5.10?
    # $_[0] // "<undefined>";
}

print "Foo = ", maybeUndef($Foo), "\n",
      "Bar = ", maybeUndef($Bar), "\n";

It uses maybeUndef to explicitly show when a value is undefined and also to silence potential undefined-value warnings.

The program seems to run as intended

$ ./prog1
Foo = apple
Bar = orange

but the output is the same even when an argument of two is supplied on the command line!

$ ./prog1 two
Foo = apple
Bar = orange

The good news is that the imported variables are in scope for the rest of the program, as indicated in the above documentation for use (with emphasis added):

Imports some semantics into the current package from the named module …

To understand why we never see Perlmodule_002’s $Foo and $Bar, note that use “is exactly equivalent to” require at BEGIN time, and the perlmod documentation explains exactly when that is (with added emphasis):

A BEGIN code block is executed as soon as possible, that is, the moment it is completely defined, even before the rest of the containing file (or string) is parsed.

So the compiler sees use Perlmodule_002 and processes it. Then it sees use Perlmodule_001 and processes it. When the compiler finishes digesting the rest of the code, it’s time for the execution phase, when the @ARGV check finally takes place. As written, Perlmodule_001 will always win!

Because ordinary modules affect the current package, use–ing an ordinary module inside a conditional block is entirely misleading. I was careful to qualify the previous statement for ordinary modules because the effects of some pragmatic modules (e.g., strict and integer—note the lowercase names!) are limited tightly to the enclosing block only.

The fix is to process @ARGV at BEGIN time and conditionalize the module imports with the equivalent require and import:

#! /usr/bin/perl

use warnings;
use strict;

BEGIN {
    if (@ARGV && $ARGV[0] eq "two") {
        require Perlmodule_002;
        Perlmodule_002->import;
    }
    else {
        require Perlmodule_001;
        Perlmodule_001->import;
    }
}

sub maybeUndef {
    defined $_[0] ? $_[0] : "<undefined>";
    # got 5.10?
    # $_[0] // "<undefined>";
}

print "Foo  = ", maybeUndef($Foo), "\n",
      "Bar  = ", maybeUndef($Bar), "\n";

An alternative is protecting use with eval as in

BEGIN {
    if (@ARGV && $ARGV[0] eq "two") {
        eval "use Perlmodule_002";
    }
    # ...

so a particular use runs only when control reaches its eval but is ignored otherwise. This is a safe, sensible use of eval.

Either way, the program now does what we expect!

$ ./prog2
Foo  = apple
Bar  = orange
$ ./prog2 two
Foo  = 42
Bar  = w00t!

You might wonder why the code has to be inside a BEGIN block after the use lines are conditionalized. If you have the strict pragma enabled—and you should!—it wants variables to be imported and declared before execution begins. Otherwise, compilation will fail because for all it knows, $Foo and $Bar in the main package were typos.

Perl: conditional use and scope was originally published by Greg Bacon at blog.gbacon.com on March 01, 2010.

Finding duplicates with Perl and Haskell

2009-08-31T00:00:00-05:00

A coworker wanted to check a family of log files to be sure that a given task never appeared on multiple nodes at the same time. Log entries are on single, whitespace-separated lines, and the last field records a task’s start time, e.g.,

1251475056672590000_1732248586_4

Of the three underscore–separated fields, the first is a timestamp, the second we don’t care about, and the third is a task identifier.

This task is straightforward with Perl. The diamond operator (or null filehandle, as described in the “I/O Operators” section of the perlop manpage) takes care of the boilerplate for iterating over the paths on the command line, opening them, and reading each line. The scalar $ARGV contains the name of the current file.

By default, split separates fields by whitespace, so (split)[-1] gives us the last field, from which we then grab the time and task with a regular expression and record its presence by pushing the entry’s path and line number onto an array associated with that time/task pair. After we’ve processed the logs, these arrays should all be singletons.

The continue clause is a little weird but necessary because the special variable $., the current line number, does not reset on <>’s implicit opens. ARGV is a handle on the file being read.

With this data structure, detecting duplicates is a search for time/task pairs with multiple hits. We count duplicates and let the user know what we found.

#! /usr/bin/perl
use warnings;
use strict;

# e.g., $hits = @{ $seen{$time}{$task} };
my %seen;

sub num { $a <=> $b }

while (<>) {
    if ((split)[-1] =~ /^(\d+)_\d+_(\d+)$/) {
        my($time,$task) = ($1,$2);
        push @{ $seen{$time}{$task} } => "$ARGV:$.";
    }
    else {
        die "$0: $ARGV:$.: bad timestamp/task field\n";
    }
}
continue {
    close ARGV if eof;
}

my $duplicates = 0;
foreach my $time (sort num keys %seen) {
    foreach my $task (sort num keys %{ $seen{$time} }) {
        my @hits = @{ $seen{$time}{$task} };
        next if @hits == 1;

        $duplicates += @hits - 1;
        warn "$0: duplicates for time=$time, task=$task:\n",
             map "    - $_\n", @hits;
    }
}

my $s = $duplicates == 1 ? "" : "s";
print "$0: $duplicates duplicate$s detected.\n";

exit $duplicates == 0 ? 0 : 1;

For comparison, I implemented the same log checker in Haskell. The function allInputs emulates Perl’s diamond operator, and instead of a multi–level hash, the association is more direct: time/task pair to a list of hits.

module Main where

import Control.Monad (liftM)
import Data.List (sort)
import Data.Map (empty,filter,fromListWith,toList,unionWith)
import Prelude hiding (filter)
import System.Environment (getArgs,getProgName)
import System.Exit (ExitCode(..),exitWith)
import Text.Printf (printf)

type Time = String
type Task = String
data Duplicates =
   Duplicates { timestamp :: Time
              , taskId    :: Task
              , locations :: [(FilePath, Int)]
              }

main :: IO ()
main = do
    logs <- allInputs
    let multi = dups logs
        n = sum $ map (subtract 1 . length . locations) multi
     mapM_ (msg . lines . dupmsg) multi
     msg $ ndups n
     exitWith $ if n == 0
                then ExitSuccess
                else ExitFailure 1
    where
        msg info = do me <- getProgName
                      putStrLn $ me ++ ": " ++ head info
                      mapM_ putStrLn (tail info)

        ndups 1 = ["1 duplicate detected"]
        ndups n = [show n ++ " duplicates detected"]

        dupmsg (Duplicates tm task ls) = unlines $
            printf "duplicates for time=%s, task=%s:" tm task :
            map (\(path,n) -> printf "    - %s:%d" path n) ls

allInputs :: IO [(FilePath, String)]
allInputs = getArgs >>= go
    where go [] = ((:[]) . (,) "-") `liftM` getContents
           go fs = mapM readFile fs >>= return . zip fs

dups :: [(FilePath, String)] -> [Duplicates]
dups = map (\((tm,task),ds) -> Duplicates tm task ds) .
       sort .
       toList .
       filter ((> 1) . length) .
       foldl (unionWith (++)) empty .
       map (\(path, contents) ->
              fromListWith (++) $
              map (wrap path . getTimeTask) $
              zip [1..] $ lines contents)
    where
        wrap path (tm,task,n) = ((tm,task), [(path,n)])

getTimeTask :: (Int,String) -> (Time,Task,Int)
getTimeTask (n,line) = (tm,tsk,n)
    where
        [tm,_,tsk] = splitBy '_' (last $ words line)

        splitBy :: Eq a => a -> [a] -> [[a]]
        splitBy _ [] = []
        splitBy x xs = h : splitBy x t
            where (h,rest) = break (== x) xs
                  t = drop 1 rest

Finding duplicates with Perl and Haskell was originally published by Greg Bacon at blog.gbacon.com on August 31, 2009.

Immanuel

2009-08-16T00:00:00-05:00

For a child will be born to us, a son will be given to us;
  And the government will rest on His shoulders;
  And His name will be called Wonderful Counselor, Mighty God,
  Eternal Father, Prince of Peace.

Isaiah 9:6

Immanuel was originally published by Greg Bacon at blog.gbacon.com on August 16, 2009.

git: shrinking Subversion import

2009-08-08T00:00:00-05:00

At $WORK we’ve been attempting for years—but fairly infrequently—to do distributed development with centralized Subversion. We finally had enough and decided to move to git.

Part of that move involved importing a couple of projects with 6+ years of history. Early revisions carried lots of binary test data, so git svn clone produced repositories weighing in at 3.5 and 4.5 gigabytes.

Another less than satisfactory result was the umpteen bazillion git branches corresponding to git tags. Some of the git branches formed families with names of the form name-x.y.z@1234, where name-x.y.z is the name of a Subversion release tag and 1234 was a Subversion revision that modified the tag. A happy design choice made the branch name-x.y.z (with no @nnn) the head revision of that Subversion tag, so we easily picked off some targets:

$ git branch -r -D $(git branch -r | grep @)

Cribbing from svn2git, converting the git branches to git tags was a series of commands of the form

$ git checkout 1.2.3
$ git tag -a -m 'Tagging release 1.2.3' v1.2.3
$ git branch -r -D 1.2.3

Then to make the Subversion trunk the git master branch:

$ git branch -D master
$ git checkout trunk
$ git checkout -f -b master
$ git branch -r -D trunk

Here’s a good point to checkpoint your work in case you hose something later.

Using Antony Stubbs’s script to find the biggest objects in a repo’s packs, we determined that much of the bulk came from huge HDF5-format test baselines along with a few others. So we cut them out:

$ git filter-branch -d /dev/shm/scratch --index-filter \
  "git rm --cached -f --ignore-unmatch '*.h5'; \
   git rm --cached -f --ignore-unmatch '*.sig'; \
   git rm --cached -f --ignore-unmatch '*.2dsc'" \
  --tag-name-filter cat -- --all

The use of --index-filter makes the long process (remember, it has to hit all possible revisions) quicker because it operates directly on the index rather than checking out every snapshot, munging the filesystem, and shoving the new snapshot back in. Also, /dev/shm is a tmpfs mount for better throughput, and the directory named with -d shouldn’t exist.

The git filter-branch manpage has a checklist for shrinking a repository that recommends running filter-branch and then cloning to leave behind the cruft.

Cloning with a filesystem path makes hardlinks, so use a URL:

$ git clone file:///home/gbacon/src/repo.git

Even after doing this, some big unnamed blobs had survived the clone. Thanks to #git on freenode for the suggestion to excise the reflog:

$ git reflog expire --verbose --expire=0 --all
$ git gc --prune=0

Note that these options will require a fairly recent git.

After all these steps, the git repositories were went from gigabytes to 75 and 100 megabytes, much nicer!

git: shrinking Subversion import was originally published by Greg Bacon at blog.gbacon.com on August 08, 2009.

Simple FitNesse example with CSlim

2009-07-27T00:00:00-05:00

Tinkering with the FitNesse acceptance testing system, I cloned the CSlim repo, but its README was short on detail about getting the thing to talk to FitNesse.

Attempting to build (on Ubuntu karmic) out of the box failed:

$ make
compiling ListExecutor.c
compiling SlimConnectionHandler.c
compiling SlimList.c
compiling SlimListDeserializer.c
compiling SlimListSerializer.c
compiling SlimUtil.c
compiling StatementExecutor.c
compiling SymbolTable.c
compiling SocketServer.c
compiling TcpComLink.c
Building archive lib/libCSlim.a
ar: lib/libCSlim.a: No such file or directory
make: *** [lib/libCSlim.a] Error 1

The workaround is straightforward: mkdir lib followed by make.

So now what?

$ ./CSlim_server --help
getaddrinfo: Servname not supported for ai_socktype

Following the recommendation in the SLiM docs, I created a page called CslimTest (by editing FrontPage to contain a new line with CslimTest) that contained merely

!define TEST_SYSTEM {slim}

After I clicked the Test button, the page cleared, paused for a few seconds, and then gave a red box with “Testing was interupted and results are incomplete.” Clicking Output Captured, I saw a stacktrace that ended with

java.lang.ClassNotFoundException: fitnesse.slim.SlimService

Maybe I could crib from the docs for another server. The FitNesse download page points to servers for various languages, and from there I arrived at a Getting Started page for fitSharp, a C# server for FitNesse, which had the following config:

!define TEST_SYSTEM {slim}
!path c:\myfolder\mytest.dll
!define COMMAND_PATTERN {%m -r fitSharp.Slim.Service.Runner,c:\program files\fitsharp\fitsharp.dll %p}
!define TEST_RUNNER {c:\program files\fitsharp\Runner.exe}

So next I try

!define TEST_SYSTEM {slim}
!define TEST_RUNNER {/home/gbacon/src/cslim/CSlim_server}

I got a similar failure, but this time the class that failed to load was .home.gbacon.src.cslim.CSlim_server.

Even though the fitSharp used !path for test assemblies, Drew suggested pointing it to CSlim_server as in

!define TEST_SYSTEM {slim}
!path /home/gbacon/src/cslim/CSlim_server

But the test still died with ClassNotFoundException.

I monkeyed more with COMMAND_PATTERN, and finally got a quick error using

!define TEST_SYSTEM {slim}
!path /home/gbacon/src/cslim/CSlim_server
!define COMMAND_PATTERN {%m %p}

Instead of Output Captured, I see Tests Executed OK. I notice in src/Main/DecisionTableExample.c there’s a Division fixture that seems to match the example in the two–minute example, so I copy-and-paste to get

!define TEST_SYSTEM {slim}
!path /home/gbacon/src/cslim/CSlim_server
!define COMMAND_PATTERN {%m %p}

|eg.Division|
|setNumerator|setDenominator|Quotient?|
|10          |2             |5        |
|12.6        |3             |4.2      |
|100         |4             |33       |

Red box still, and the tests aren’t running. Not much help in the output log, but FitNesse complained:

Cannot run program "fitnesse.slim.SlimService".

Remove %m from COMMAND_PATTERN. Progress! Nothing’s running, but I see a bunch of exceptions and text with yellow backgrounds, such as “eg.Division Could not find class eg.Division.” Maybe it doesn’t like the leading eg.

!define TEST_SYSTEM {slim}
!path /home/gbacon/src/cslim/CSlim_server
!define COMMAND_PATTERN {%p}

|Division|
|setNumerator|setDenominator|Quotient?|
|10          |2             |5        |
|12.6        |3             |4.2      |
|100         |4             |33       |

Now Division goes green, but it doesn’t like the input methods ("Method setSetNumerator\[1] not found in Division." for example). The method names in the fixture are setNumerator, setDenominator, and Quotient, so mangling must be happening somewhere.

That’s what I get for trying to think ahead of it:

!define TEST_SYSTEM {slim}
!define COMMAND_PATTERN {%p}
!path /home/gbacon/src/cslim/CSlim_server

|Division|
|numerator|denominator|Quotient?|
|10       |2          |5        |
|12.6     |3          |4.2      |
|100      |4          |33       |

Now the first two rows pass, and the third fails as expected.

Simple FitNesse example with CSlim was originally published by Greg Bacon at blog.gbacon.com on July 27, 2009.

Just for you, Madeline

2009-07-11T00:00:00-05:00

My five-year-old daughter is learning to read. I made flash cards for us to practice phonics and recognition, and I wrote this simple app to give her a way to practice on her own too. Thanks to the Wiktionary folks for the pronunciations.

Along with the buttons, you can advance by pressing Enter or Right-Arrow and hear the word with S or space bar.

The code is available on GitHub.

Just for you, Madeline was originally published by Greg Bacon at blog.gbacon.com on July 11, 2009.

Cleaning up your Haskell imports

2009-06-29T00:00:00-05:00

Explicit imports have a couple of benefits. For one, doing so reduces compile times with ghc. Another is giving a hand to your future self (or other maintainers) and especially to those who are reading your code to learn. We’ve all been there: scratching our heads wondering, ‘Where does that function live?’ Yes, ghci’s :info command and Hoogle are your friends, but explicit imports right there in your code will give the answer in a snap.

Neil Mitchell calls explicit imports “needlessly verbose,” certainly a fair point in the context where he made it, so this is a matter of polish, not strict necessity. There’s also a certain aspy-appeal to it.

The -ddump-minimal-imports option to ghc writes the cleaned–up list to M.imports, where M is the module being compiled. For example, consider the following code that finds anagrams in a dictionary file:

module Main where

import Control.Arrow
import Control.Monad
import Data.Char
import Data.List
import Data.Map hiding (filter, map)
import System.Environment
import System.Exit
import System.IO

usage :: IO a
usage = do
  me <- getProgName
  hPutStrLn stderr $ "Usage: " ++ me ++ " [ dictionary ]"
  exitWith (ExitFailure 1)

main :: IO ()
main =
  getPath >>= readFile >>= mapM_ (putStrLn . unwords) . sorted
  where sorted = sort . map sort . anagrams . lines

anagrams :: [String] -> [[String]]
anagrams words = filter ((>1) . length) equiv
  where equiv = elems $
                  fromListWith (++)
                    [ (normal w, [w]) | w <- words ]
        normal = sort . map toLower

getPath :: IO FilePath
getPath = getArgs >>= go
  where go [path] = return path
        go []     = return "/usr/share/dict/words"
        go _      = usage

To get the minimal set of imports:

$ ghc-6.10.3 -ddump-minimal-imports --make anagram.hs
$ cat Main.imports
import System.IO(IO, FilePath, putStrLn, readFile, hPutStrLn,
                 stderr)
import Data.Map(elems, fromListWith)
import Control.Arrow()    -- Instances only
import Control.Monad(Monad(return, (>>=)), mapM_)
import Data.Char(String, toLower)
import Data.List((++), filter, map, length, lines, unwords, sort)
import System.Environment(getArgs, getProgName)
import System.Exit(ExitCode(ExitFailure), exitWith)

Although nice, the result is less than satisfying. The cuddled lists are ugly. The imports are in an odd order. Having to do run a separate compilation by hand followed by copy-paste, as opposed to automatically à la Eclipse’s organize imports for Java, is a bit of a pain.

Notice that although Control.Arrow is unnecessary, it remains in the “minimal” set with an empty import list. Its presence is an artifact of the list comprehension being equivalent to

map (normal &&& (:[])) words

Cool, yes. Readable, not so much.

Note also there’s an open ticket against ghc concerning the interaction between -ddump-minimal-imports and qualified imports.

Cleaning up your Haskell imports was originally published by Greg Bacon at blog.gbacon.com on June 29, 2009.

My first monadic program!

2007-02-25T00:00:00-06:00

Problem 32 from Project Euler reads

The product 7254 is unusual, as the identity, 39 × 186 = 7254, containing multiplicand, multiplier, and product is 1 through 9 pandigital.

Find the sum of all products whose multiplicand/multiplier/product identity can be written as a 1 through 9 pandigital.

Not one of my brighter moments, the first approach I considered was applying goon–force to permute a list of eleven characters ('1' .. '9', 'x', and '=') — a search space of almost 40 million — looking for well-formed and valid statements.

Initially, I looked at using Text.Regex. As I was fishing for examples to crib from, I saw a suggestion that people may as well use Parsec, the monadic parser combinator library. So let’s knock out the preliminaries:

> module Main where
>
> import Data.List hiding (map)
> import Text.ParserCombinators.Parsec

A parser for the simple expressions reads easily:

> num :: Parser Int
> num = do ns <- many1 digit
>          return $ read ns
>
> expression :: Parser (Int,Int,Int)
> expression = do multiplier <- num
>                 times <- char 'x'
>                 multiplicand <- num
>                 equals <- char '='
>                 product <- num
>                 return (multiplier, multiplicand, product)

Generating permutations is no problem in Haskell:

> permutations :: [a] -> [[a]]
> permutations [x] = [[x]]
> permutations xs =
>   [ y : zs
>   | (y,ys) <- selections xs
>   , zs     <- permutations ys
>   ]
>
> selections []     = []
> selections (x:xs) = (x,xs) : [(y,x:ys) | (y,ys) <- selections xs]

I’d been wanting to solve as a learning example one of the Project Euler problems using monads. As I tried to shoehorn the problem into a monadic solution, I remembered the characterization of the Maybe monad as being useful for computations that can fail, and I saw two possibilities for failure: garbage input (e.g., "x=123456789") and false statements (e.g., "1x2=3456789").

Having a particular permutation, check tests whether it’s well–formed and valid:

check :: String -> Maybe Int
check s = do
  result <- parseExpr s
  p <- validProduct result
  return p

parseExpr :: String -> Maybe (Int,Int,Int)
parseExpr s =
  case parse expression "expression" s of
    Left err -> Nothing
    Right tuple@(mr,md,pr) -> return tuple

validProduct (mr, md, pr)
  | mr * md == pr = Just pr
  | otherwise = Nothing

The test goes just as you would describe it to someone else: parse the input to extract the multiplier, multiplicand, and product. Then check whether the operation holds. Simple.

Fitting these puzzle pieces together also helped another concept click. I remember reading characterizations of being “inside the monad” and feeling mystified. Notice, for example, that parseExpr has type String → Maybe (Int,Int,Int). That is, given a string, the result is either Nothing or Just x, where x is a 3-tuple. Another way to think about the latter case is Just with some (Int,Int,Int) inside it.

Continuing the concept, consider how parseExpr is used in check. The result from parseExpr becomes on the next line an argument to validProduct. You might be tempted to object that the types don’t line up! validProduct wants a plain tuple, but parseExpr gives Maybe (Int,Int,Int).

For the program to typecheck, result must be a tuple with no wrapper. When “inside the monad,” you can directly access the value without having to explicitly unwrap it.

You wonder, ‘But what about when the parse fails or when the statement is bogus?’ In addition to implicitly unwrapping, the Maybe monad and do-notation syntactic sugar are checking these cases too! “Control” (to borrow an imperative concept) reaches the return p line only if both parseExpr and validProduct succeed. Otherwise, check bails where the failure occurs and returns Nothing.

All that’s left to do is feed it input and sum the result. Note: it’s very s-l-o-w.

p32 = sum $ elems $ fromList $ catMaybes $ map check (permutations cs)
  where cs = ['1','2','3','4','5','6','7','8','9','x','=']

An obvious improvement is to use nub instead of (elems . fromList). Even better, lists are also monads, so Maybe distractions disappear with only a few very minor changes:

> p32 = sum (nub $ concatMap check (permutations cs))
>   where cs = ['1','2','3','4','5','6','7','8','9','x','=']
>
> main = print p32
>
> check :: (Monad m) => String -> m Int
> check s = do
>   result <- parseExpr s
>   p <- validProduct result
>   return p
>
> parseExpr :: (Monad m) => String -> m (Int,Int,Int)
> parseExpr s =
>     case parse expression "expression" s of
>       Left err -> fail (show err)
>       Right tuple@(mr,md,pr) -> return tuple
>
> validProduct :: (Monad m) => (Int,Int,Int) -> m Int
> validProduct (mr, md, pr)
>   | mr * md == pr = return pr
>   | otherwise = fail "invalid product"

This works because failure in the list monad is the empty list, and concatMap gets rid of all the empties.

My first monadic program! was originally published by Greg Bacon at blog.gbacon.com on February 25, 2007.

Trigonometry refactored?

2005-09-17T00:00:00-05:00

This afternoon on #perl, the topic was "Trig refactored to remove sin/cos/tan" with a pointer to the upcoming Divine Proportions: Rational Trigonometry to Universal Geometry by N J Wildberger.

The introduction makes an ambitious claim:

Rational trigonometry deals with many practical problems in an easier and more elegant fashion than classical trigonometry, and often ends up with answers that are demonstrably more accurate. In fact rational trigonometry is so elementary that almost all calculations may be done by hand. Tables or calculators are not necessary, although the latter certainly speed up computations. It is a shame that this theory was not discovered earlier, since accurate tables were for many centuries not widely available.
Because rational trigonometry uses only arithmetic and algebra, it allows the development of Euclidean geometry in a consistent and general way in an arbitrary field. This is universal geometry.

Emphasis Wildberger's, not mine. I look forward to reading more!

Trigonometry refactored? was originally published by Greg Bacon at blog.gbacon.com on September 17, 2005.

Processing lines in a TextBox

2005-07-05T00:00:00-05:00

Below is a simple example of processing all lines in a TextBox.

public static void WriteFile(string path, string contents)
{
  using (StreamWriter w = new StreamWriter(path))
    w.Write(contents);
}

public static void LineByLine(TextReader reader)
{
  Console.WriteLine("input type = " + reader.GetType());

  int n = 1;
  string line;
  while ((line = reader.ReadLine()) != null)
    Console.WriteLine(n++ + ". [" + line + "]");
}

static void Main(string[] args)
{
  string text =
    "The quick\n" +
    "brown fox jumped over\n" +
    "the lazy dog.";

  string path = "foo.txt";
  WriteFile(path, text);
  using (StreamReader streamr = new StreamReader(path))
    LineByLine(streamr);

  TextBox textbox = new TextBox();
  textbox.Text = text;
  using (StringReader stringr = new StringReader(textbox.Text))
    LineByLine(stringr);
}

Processing lines in a TextBox was originally published by Greg Bacon at blog.gbacon.com on July 05, 2005.