INN2 Cancel-Lock, implémentation RFC8315 (filtres perl)

Gérald Niel

unread,

Feb 8, 2021, 1:37:10 AM2/8/21

to

[posté sur fr.comp.usenet.serveurs,fr.comp.lang.perl]
[suivi sur fr.comp.lang.perl]

Bonjour,

suite à la mise en place de l'ajout des entêtes Cancel-Lock et
Cancel-Key le cas échéants j'ai adapté les deux scripts suivant pour
être conforme avec la RFC8315 :

1. <https://code.th-h.de/?p=usenet/INN.git;a=blob;f=filter/filter_nnrpd.pl;h=a66425b098a1ae35733c29cfd5bf7ed6c0564509;hb=8faa6b210ccf89fd3509f69b4c2005e40f5485a5;js=1>

Celui-ci, c'est au niveau de nnrpd pour ajouter la ou les entêtes.

2. <https://code.th-h.de/?p=usenet/INN.git;a=blob;f=filter/cleanfeed.local;h=e3b872c7860f88e8607efac48d2637a8ce9ada97;hb=8faa6b210ccf89fd3509f69b4c2005e40f5485a5;js=1>

Celui-ci, c'est au niveau de cleanfeed, afin de vérifier et n'accèpter
l'annulation que si la clef correspond au verrou. Que ce soit au
niveau des feed pour accèpter l'annulation ou avant de poster l'article.

Les deux fonctionnent bien, à priori il ne devrait pas y avoir de
modifications à faire sur le premier, c'est sur le second qu'il y a à
améliorer.

Voici le code des deux scripts :

## filter_nnrpd.perl

Premier point : je pense que l'ajout de la ou des en-têtes devrait se
faire dans la fonction (ou procédure) `filter_end` et non pas dans
`filter_post` car ce n'est pas un filtre à proprement parler.
Je n'ai pas encore déplacé dans cette routine.

```perl
use Digest::SHA qw( sha256_base64 hmac_sha256_base64 );
$CANCEL_LOCK = 'pass_phrase';

sub filter_post {
my $rval = "" ; # assume we'll accept.
$modify_headers = 1;

# Cancel-Lock / Cancel-Key

## Ajout Cancel-Lock
add_cancel_lock(\%hdr, $user);

## Ajout Cancel-Key si cancel ou supersedes
if (exists( $hdr{"Control"} ) && $hdr{"Control"} =~ m/^cancel\s+(<[^>]+>)/i) {
my $key = calc_cancel_key($user, $1);
add_cancel_item(\%hdr, 'Cancel-Key', $key);
}
elsif (exists( $hdr{"Supersedes"} )) {
my $key = calc_cancel_key($user, $hdr{"Supersedes"});
add_cancel_item(\%hdr, 'Cancel-Key', $key);
}
}

#
# Cancel-Lock / Cancel-Key
#

sub pad_b64digest($) {
my ($b64_digest) = @_;
while (length($b64_digest) % 4) {
$b64_digest .= '=';
}
return $b64_digest;
}

sub add_cancel_item($$$) {
my ( $r_hdr, $name, $value ) = @_;
my $prefix = $r_hdr->{$name};
$prefix = defined($prefix) ? $prefix . ' sha256:' : 'sha256:';
$r_hdr->{$name} = $prefix . $value;
}

sub calc_cancel_key($$) {
my ( $user, $message_id ) = @_;
return pad_b64digest(Digest::SHA::hmac_sha256_base64($message_id, $user . $CANCEL_LOCK));
}

sub add_cancel_lock($$) {
my ( $r_hdr, $user ) = @_;
my $key = calc_cancel_key($user, $r_hdr->{'Message-ID'});
my $lock = pad_b64digest(Digest::SHA::sha256_base64($key));
add_cancel_item($r_hdr, 'Cancel-Lock', $lock);
}
```

## cleanfeed.local

C'est pour celui-là que j'ai besoin d'aide, si je comprends ce que ça
fait et suis capable d'adapter je ne maitrise pas vraiment perl. ;)

Je pense qu'il y aurait moyen de n'utiliser que Digest::SHA.
Et peut être Digest::MD5.

Je ne garde que les portions concernées par Cancel-Lock/Key :

```perl
use MIME::Base64();
use Digest::SHA1();
use Digest::HMAC_SHA1();
use Digest::SHA qw( sha256_base64 );

sub local_filter_cancel {
return verify_cancel(\%hdr, $1, 'Cancel');
}

sub verify_cancel($$$) {
my $r_hdr = shift || die;
my $target = shift;
my $descr = shift;

my $headers = INN::head($target) || return "$descr of non-existing ID $target";

my %headers;
for my $line(split(/\s*\n/, $headers)) {
if ($line =~ m/^([[:alnum:]-]+):\s+(.*)/) {
$headers{$1} = $2;
}
}

my $lock = $headers{'Cancel-Lock'};
if (defined($lock)) {
my $key = $r_hdr->{'Cancel-Key'} || return "$descr of $target without Cancel-Key";
return verify_cancel_key($key, $lock, $target);
}
else {
INN::cancel($target);
}

return undef;
}

## C'est ici qu'il y a quelque chose à faire
## Le script tient compte des 3 formats de clefs/verrous possible
## (deux dans l'original).
## L'adaptation est pour gérer les clef SHA256 en plus de SHA-1 et MD5.
## Cancel-Lock peut contenir plusieurs hash si ajouté par le client,
## puis le serveur, séparé par un espace dans ce cas.

sub verify_cancel_key($$$) {
my $cancel_key = shift;
my $cancel_lock = shift;
my $msg = shift;

$msg = '' unless(defined($msg));

my $target = $msg;
$msg = ' target=' . $msg;

my %lock;
for my $l(split(/\s+/, $cancel_lock)) {
next unless($l =~ m/^(sha256|sha1|md5):(\S+)/);
$lock{$2} = $1;
}

for my $k(split(/\s+/, $cancel_key)) {
unless($k =~ m/^(sha256|sha1|md5):(\S+)/) {
INN::syslog('notice', "Invalid Cancel-Key syntax '$k'.$msg");
next;
}

my $key;
if ($1 eq 'sha1') {
$key = Digest::SHA1::sha1($2);
$key = MIME::Base64::encode_base64($key, ''); }
elsif ($1 eq 'md5') {
$key = Digest::MD5::md5($2);
$key = MIME::Base64::encode_base64($key, ''); }
elsif ($1 eq 'sha256') {
$key = sha256_base64($2);
while (length($key) % 4) {
$key .= '=';
}
}

if (exists($lock{$key})) {
INN::syslog('notice', "Valid Cancel-Key $key found.$msg");

# article is canceled now
INN::cancel($target) if ($target);
return undef;
}
}

INN::syslog('notice',
"No Cancel-Key[$cancel_key] matches Cancel-Lock[$cancel_lock]$msg"
);
return "No Cancel-Key matches Cancel-Lock.$msg";
}
```

--
On ne le dira jamais assez, l'anarchisme, c'est l'ordre sans le
gouvernement ; c'est la paix sans la violence. C'est le contraire
précisément de tout ce qu'on lui reproche, soit par ignorance, soit
par mauvaise foi. -+- Hem Day -+-

Gérald Niel

unread,

Feb 8, 2021, 2:24:37 AM2/8/21

to

Le Lundi 08 février 2021 à 06:37 UTC, Gérald Niel écrivait sur
fr.comp.lang.perl :

> Je pense qu'il y aurait moyen de n'utiliser que Digest::SHA.
> Et peut être Digest::MD5.

> Je ne garde que les portions concernées par Cancel-Lock/Key :

> ```perl
> use MIME::Base64();
> use Digest::SHA1();
> use Digest::HMAC_SHA1();
> use Digest::SHA qw( sha256_base64 );

Ici, je modifie pour n'utiliser que :

```perl
use Digest::SHA qw( sha1_base64 sha256_base64 );
use Digest::MD5 qw( md5_base64 );
```

Ensuite,

> ## C'est ici qu'il y a quelque chose à faire
> ## Le script tient compte des 3 formats de clefs/verrous possible
> ## (deux dans l'original).
> ## L'adaptation est pour gérer les clef SHA256 en plus de SHA-1 et MD5.
> ## Cancel-Lock peut contenir plusieurs hash si ajouté par le client,
> ## puis le serveur, séparé par un espace dans ce cas.

> sub verify_cancel_key($$$) {

[…]

> my $key;
> if ($1 eq 'sha1') {
> $key = Digest::SHA1::sha1($2);
> $key = MIME::Base64::encode_base64($key, ''); }
> elsif ($1 eq 'md5') {
> $key = Digest::MD5::md5($2);
> $key = MIME::Base64::encode_base64($key, ''); }
> elsif ($1 eq 'sha256') {
> $key = sha256_base64($2);
> while (length($key) % 4) {
> $key .= '=';
> }
> }

Je remplace par :
```perl
my $key;

if ($1 eq 'sha256') {
$key = sha256_base64($2);
}

elsif ($1 eq 'sha1') {
$key = sha1_base64($2);

}
elsif ($1 eq 'md5') {

$key = md5_base64($2);
}
$key = pad_b64digest(($key;
```

Et je rajoute la fonction :

```perl

sub pad_b64digest($) {
my ($b64_digest) = @_;
while (length($b64_digest) % 4) {
$b64_digest .= '=';
}
return $b64_digest;
}

```

Je n'ai pas encore testé, je voudrais savoir si c'est la bonne méthode
et surtout, si "sur le papier" ça fonctionne.

Gérald Niel

unread,

Feb 8, 2021, 2:30:04 AM2/8/21

to

Le Lundi 08 février 2021 à 06:37 UTC, Gérald Niel écrivait sur
fr.comp.lang.perl :

> Je pense qu'il y aurait moyen de n'utiliser que Digest::SHA.
> Et peut être Digest::MD5.

> Je ne garde que les portions concernées par Cancel-Lock/Key :

> ```perl
> use MIME::Base64();
> use Digest::SHA1();
> use Digest::HMAC_SHA1();
> use Digest::SHA qw( sha256_base64 );

Ici, je modifie pour n'utiliser que :

```perl

use Digest::SHA qw( sha1_base64 sha256_base64 );
use Digest::MD5 qw( md5_base64 );
```

Ensuite,

> ## C'est ici qu'il y a quelque chose à faire
> ## Le script tient compte des 3 formats de clefs/verrous possible
> ## (deux dans l'original).
> ## L'adaptation est pour gérer les clef SHA256 en plus de SHA-1 et MD5.
> ## Cancel-Lock peut contenir plusieurs hash si ajouté par le client,
> ## puis le serveur, séparé par un espace dans ce cas.

> sub verify_cancel_key($$$) {

[…]

> my $key;
> if ($1 eq 'sha1') {
> $key = Digest::SHA1::sha1($2);
> $key = MIME::Base64::encode_base64($key, ''); }
> elsif ($1 eq 'md5') {
> $key = Digest::MD5::md5($2);
> $key = MIME::Base64::encode_base64($key, ''); }
> elsif ($1 eq 'sha256') {
> $key = sha256_base64($2);
> while (length($key) % 4) {
> $key .= '=';
> }
> }

Je remplace par :
```perl
my $key;

if ($1 eq 'sha256') {
$key = sha256_base64($2);
}

elsif ($1 eq 'sha1') {
$key = sha1_base64($2);

}
elsif ($1 eq 'md5') {

$key = md5_base64($2);
}
$key = pad_b64digest(($key));

```

Et je rajoute la fonction :

```perl

sub pad_b64digest($) {
my ($b64_digest) = @_;
while (length($b64_digest) % 4) {
$b64_digest .= '=';
}
return $b64_digest;
}

```

Je n'ai pas encore testé, je voudrais savoir si c'est la bonne méthode
et surtout, si "sur le papier" ça fonctionne.

Gérald Niel

unread,

Feb 8, 2021, 2:30:57 AM2/8/21

to

(supersedes bis)

Le Lundi 08 février 2021 à 06:37 UTC, Gérald Niel écrivait sur
fr.comp.lang.perl :

> Je pense qu'il y aurait moyen de n'utiliser que Digest::SHA.
> Et peut être Digest::MD5.

> Je ne garde que les portions concernées par Cancel-Lock/Key :

> ```perl
> use MIME::Base64();
> use Digest::SHA1();
> use Digest::HMAC_SHA1();
> use Digest::SHA qw( sha256_base64 );

Ici, je modifie pour n'utiliser que :

```perl

use Digest::SHA qw( sha1_base64 sha256_base64 );
use Digest::MD5 qw( md5_base64 );
```

Ensuite,

> ## C'est ici qu'il y a quelque chose à faire
> ## Le script tient compte des 3 formats de clefs/verrous possible
> ## (deux dans l'original).
> ## L'adaptation est pour gérer les clef SHA256 en plus de SHA-1 et MD5.
> ## Cancel-Lock peut contenir plusieurs hash si ajouté par le client,
> ## puis le serveur, séparé par un espace dans ce cas.

> sub verify_cancel_key($$$) {

[…]

> my $key;
> if ($1 eq 'sha1') {
> $key = Digest::SHA1::sha1($2);
> $key = MIME::Base64::encode_base64($key, ''); }
> elsif ($1 eq 'md5') {
> $key = Digest::MD5::md5($2);
> $key = MIME::Base64::encode_base64($key, ''); }
> elsif ($1 eq 'sha256') {
> $key = sha256_base64($2);
> while (length($key) % 4) {
> $key .= '=';
> }
> }

Je remplace par :
```perl
my $key;

if ($1 eq 'sha256') {
$key = sha256_base64($2);
}

elsif ($1 eq 'sha1') {
$key = sha1_base64($2);

}
elsif ($1 eq 'md5') {

$key = md5_base64($2);
}
$key = pad_b64digest($key);

```

Et je rajoute la fonction :

```perl

sub pad_b64digest($) {
my ($b64_digest) = @_;
while (length($b64_digest) % 4) {
$b64_digest .= '=';
}
return $b64_digest;
}

```

Je n'ai pas encore testé, je voudrais savoir si c'est la bonne méthode
et surtout, si "sur le papier" ça fonctionne.

Gérald Niel

unread,

Feb 8, 2021, 6:39:12 AM2/8/21

to

Je me répond à moi même.

Le Lundi 08 février 2021 à 07:30 UTC, Gérald Niel écrivait sur
fr.comp.lang.perl :

> Je n'ai pas encore testé, je voudrais savoir si c'est la bonne méthode
> et surtout, si "sur le papier" ça fonctionne.

"Sur le papier", à priori ça fonctionnait.
En prod, ça fonctionne.

Je ne sais si c'est la façon la plus propre de l'implémenter, mais ça
fonctionne. ;)

@+