<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">#!/usr/bin/perl
# OpenID support.
package IkiWiki::Plugin::openid;

use warnings;
use strict;
use IkiWiki 3.00;

sub import {
	hook(type =&gt; "getopt", id =&gt; "openid", call =&gt; \&amp;getopt);
	hook(type =&gt; "getsetup", id =&gt; "openid", call =&gt; \&amp;getsetup);
	hook(type =&gt; "auth", id =&gt; "openid", call =&gt; \&amp;auth);
	hook(type =&gt; "formbuilder_setup", id =&gt; "openid",
		call =&gt; \&amp;formbuilder_setup, last =&gt; 1);
}

sub getopt () {
	eval q{use Getopt::Long};
	error($@) if $@;
	Getopt::Long::Configure('pass_through');
	GetOptions("openidsignup=s" =&gt; \$config{openidsignup});
}

sub getsetup () {
	return
		plugin =&gt; {
			safe =&gt; 1,
			rebuild =&gt; 0,
		},
		openidsignup =&gt; {
			type =&gt; "string",
			example =&gt; "http://myopenid.com/",
			description =&gt; "an url where users can signup for an OpenID",
			safe =&gt; 1,
			rebuild =&gt; 0,
		},
}

sub formbuilder_setup (@) {
	my %params=@_;

	my $form=$params{form};
	my $session=$params{session};
	my $cgi=$params{cgi};
	
	if ($form-&gt;title eq "signin") {
		# Give up if module is unavailable to avoid
		# needing to depend on it.
		eval q{use Net::OpenID::Consumer};
		if ($@) {
			debug("unable to load Net::OpenID::Consumer, not enabling OpenID login ($@)");
			return;
		}

		# This avoids it displaying a redundant label for the
		# OpenID fieldset.
		$form-&gt;fieldsets("OpenID");

 		$form-&gt;field(
			name =&gt; "openid_url",
			label =&gt; gettext("Log in with")." ".htmllink("", "", "ikiwiki/OpenID", noimageinline =&gt; 1),
			fieldset =&gt; "OpenID",
			size =&gt; 30,
			comment =&gt; ($config{openidsignup} ? " | &lt;a href=\"$config{openidsignup}\"&gt;".gettext("Get an OpenID")."&lt;/a&gt;" : "")
		);

		# Handle submission of an OpenID as validation.
		if ($form-&gt;submitted &amp;&amp; $form-&gt;submitted eq "Login" &amp;&amp;
		    defined $form-&gt;field("openid_url") &amp;&amp; 
		    length $form-&gt;field("openid_url")) {
			$form-&gt;field(
				name =&gt; "openid_url",
				validate =&gt; sub {
					validate($cgi, $session, shift, $form);
				},
			);
			# Skip all other required fields in this case.
			foreach my $field ($form-&gt;field) {
				next if $field eq "openid_url";
				$form-&gt;field(name =&gt; $field, required =&gt; 0,
					validate =&gt; '/.*/');
			}
		}
	}
	elsif ($form-&gt;title eq "preferences") {
		if (! defined $form-&gt;field(name =&gt; "name")) {
			$form-&gt;field(name =&gt; "OpenID", disabled =&gt; 1,
				value =&gt; $session-&gt;param("name"), 
				size =&gt; 50, force =&gt; 1,
				fieldset =&gt; "login");
		}
	}
}

sub validate ($$$;$) {
	my $q=shift;
	my $session=shift;
	my $openid_url=shift;
	my $form=shift;

	my $csr=getobj($q, $session);

	my $claimed_identity = $csr-&gt;claimed_identity($openid_url);
	if (! $claimed_identity) {
		if ($form) {
			# Put the error in the form and fail validation.
			$form-&gt;field(name =&gt; "openid_url", comment =&gt; $csr-&gt;err);
			return 0;
		}
		else {
			error($csr-&gt;err);
		}
	}

	my $check_url = $claimed_identity-&gt;check_url(
		return_to =&gt; IkiWiki::cgiurl(do =&gt; "postsignin"),
		trust_root =&gt; $config{cgiurl},
		delayed_return =&gt; 1,
	);
	# Redirect the user to the OpenID server, which will
	# eventually bounce them back to auth()
	IkiWiki::redirect($q, $check_url);
	exit 0;
}

sub auth ($$) {
	my $q=shift;
	my $session=shift;

	if (defined $q-&gt;param('openid.mode')) {
		my $csr=getobj($q, $session);

		if (my $setup_url = $csr-&gt;user_setup_url) {
			IkiWiki::redirect($q, $setup_url);
		}
		elsif ($csr-&gt;user_cancel) {
			IkiWiki::redirect($q, $config{url});
		}
		elsif (my $vident = $csr-&gt;verified_identity) {
			$session-&gt;param(name =&gt; $vident-&gt;url);
		}
		else {
			error("OpenID failure: ".$csr-&gt;err);
		}
	}
	elsif (defined $q-&gt;param('openid_identifier')) {
		# myopenid.com affiliate support
		validate($q, $session, $q-&gt;param('openid_identifier'));
	}
}

sub getobj ($$) {
	my $q=shift;
	my $session=shift;

	eval q{use Net::OpenID::Consumer};
	error($@) if $@;

	my $ua;
	eval q{use LWPx::ParanoidAgent};
	if (! $@) {
		$ua=LWPx::ParanoidAgent-&gt;new;
	}
	else {
	        $ua=LWP::UserAgent-&gt;new;
	}

	# Store the secret in the session.
	my $secret=$session-&gt;param("openid_secret");
	if (! defined $secret) {
		$secret=rand;
		$session-&gt;param(openid_secret =&gt; $secret);
	}

	return Net::OpenID::Consumer-&gt;new(
		ua =&gt; $ua,
		args =&gt; $q,
		consumer_secret =&gt; sub { return shift()+$secret },
		required_root =&gt; $config{cgiurl},
	);
}

package IkiWiki;

# This is not used by this plugin, but this seems the best place to put it.
# Used elsewhere to pretty-display the name of an openid user.
sub openiduser ($) {
	my $user=shift;

	if ($user =~ m!^https?://! &amp;&amp;
	    eval q{use Net::OpenID::VerifiedIdentity; 1} &amp;&amp; !$@) {
		my $oid=Net::OpenID::VerifiedIdentity-&gt;new(identity =&gt; $user);
		my $display=$oid-&gt;display;
		# Convert "user.somehost.com" to "user [somehost.com]"
		# (also "user.somehost.co.uk")
		if ($display !~ /\[/) {
			$display=~s/^([-a-zA-Z0-9]+?)\.([-.a-zA-Z0-9]+\.[a-z]+)$/$1 [$2]/;
		}
		# Convert "http://somehost.com/user" to "user [somehost.com]".
		# (also "https://somehost.com/user/")
		if ($display !~ /\[/) {
			$display=~s/^https?:\/\/(.+)\/([^\/]+)\/?$/$2 [$1]/;
		}
		$display=~s!^https?://!!; # make sure this is removed
		eval q{use CGI 'escapeHTML'};
		error($@) if $@;
		return escapeHTML($display);
	}
	return;
}

1
</pre></body></html>