ew8bak/ewsdr
1
0
Fork 0
mirror of https://git.vladimir.cc/vladimir/ewsdr.git synced 2026-08-25 20:37:33 +00:00
Code Issues Packages Projects Releases Wiki Activity

fix(tci): писатель WAV — один поток с очередью, файл публикуется атомарно

Browse Source 
SAVE запускал поток на каждую запись с FreeOnTerminate: его никто не держал
и никто не ждал. Замерено отдельным процессом — при штатном выходе сразу
после сохранения от ожидаемых 100000044 байт на диске оставалось 40960, а
заголовок заявлял полную длину; на медленном каталоге идущие подряд SAVE
плодили сотни потоков, чья память стеков в 128-МБ бюджет не входила.

Теперь писатель один и принадлежит адаптеру (лениво на первом SAVE), очередь
ограничена TCI_RECORD_MAX_JOBS = 16 (сверх — клиенту writer busy и возврат
резерва), а деструктор адаптера гасит его через TCIStopWriter: Close →
WaitDrained (без срока) → Free. Срока здесь нет намеренно: поток, стоящий в
write/fsync, изнутри процесса не останавливается (Terminate не указ, Free
обязан WaitFor, бросить живой TThread нельзя — он ходит в общий бюджет),
поэтому срок не ограничивал выход, а только терял подтверждённые клиенту
записи. Ограниченный выход = писатель отдельным процессом, одним TThread не
делается; это записано в коде и в доке.

Результат записи больше не игнорируется: FileWrite возвращает число байт и
при ошибке даёт 0/-1 без исключения, поэтому на полном диске файл спокойно
дописывался до конца огрызком. TCIWriteAll — цикл с проверкой каждого вызова,
плюс FileFlush перед публикацией (на ext4 с отложенным размещением ENOSPC
приходит именно там).

Файл появляется под целевым именем целиком или не появляется вовсе: данные
пишутся во временный файл рядом (эксклюзивно, не по симлинку), а публикует
их TCIPublishFile — renameat2(RENAME_NOREPLACE) напрямую через Do_SysCall,
если его нет — link + unlink, если нет и ссылок (FAT/exFAT, часть CIFS/SMB и
FUSE) — отказ с сохранением данных в .part. FileExists + rename не делается
нигде: это тот самый TOCTOU. На Windows — MoveFileW без REPLACE_EXISTING.

doc/TCI.md: §2.5 переписан (писатель-очередь, остановка, публикация); заодно
исправлено устаревшее описание склейки кусков в Take (её нет с 7aae0fd).

Стенд test/tci: 214 проверок (было 199), все зелёные. Новое — временный файл
убирается после удачи, неудачная запись не оставляет ни файла, ни .part, за
всё время записи 32 МБ целевое имя ни разу не видно незаконченным, отказ
сверх потолка заданий, после Close заданий не берут, TCIStopWriter дожидается
и самой записи, и хвоста очереди за ней. Все новые гарантии прогнаны
негативным контролем; путь link проверен сборкой с выключенным renameat2,
сам renameat2 — под strace.

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
This commit is contained in:
ew8bak
2026-08-19 19:40:31 +03:00
co-authored by Claude Opus 5
parent 7aae0fdfcd
commit 3dc7035f9e
4 changed files with 734 additions and 134 deletions
Download Patch File Download Diff File Expand all files Collapse all files
test/tci/tcitest.pas
+176 -41
View File
@@ -570,6 +570,45 @@ begin
end;
end;
function MakeTake(const Data: TTCIPcm; Reserved: Int64): TTCIRecTake;
// Одно задание писателю из готового куска: в проде куски приносит Take.
begin
Result.Chunks := nil;
SetLength(Result.Chunks, 1);
Result.Chunks[0] := Data;
Result.Chunk := Length(Data) div 2;
Result.Count := Result.Chunk;
Result.Reserved := Reserved;
end;
function Drained(W: TTCIWavWriter; TimeoutMs: Integer): Boolean;
// Ограниченное ожидание очереди — ТОЛЬКО для стенда: у писателя WaitDrained
// срока не имеет (см. TCIStopWriter), а зависший стенд ничего не сообщает.
var Waited: Integer;
begin
Waited := 0;
while (W.Pending > 0) and (Waited < TimeoutMs) do
begin
Sleep(5);
Inc(Waited, 5);
end;
Result := W.Pending = 0;
end;
function PartFiles(const Path: string): Integer;
// Сколько временных файлов писателя осталось рядом с целью.
var SR: TSearchRec;
begin
Result := 0;
if FindFirst(Path + '.*', faAnyFile, SR) = 0 then
begin
repeat
Inc(Result);
until FindNext(SR) <> 0;
end;
FindClose(SR);
end;
procedure TestRecorder;
var
Rec: TTCIRecorder;
@@ -581,9 +620,11 @@ var
Hdr: array[0..43] of Byte;
Sz: LongWord;
W: TTCIWavWriter;
Waited: Integer;
Was: Int64;
Tk: TTCIRecTake;
Big: TTCIPcm;
Refused, k, Bad: Integer;
Path2: string;
begin
WriteLn('C. Рекордер линейного выхода');
@@ -753,25 +794,21 @@ begin
Rec.Free;
end;
// WAV: заголовок и длина.
Path := GetTempDir + 'tcitest_rec.wav';
// ═══ WAV и писатель ═══════════════════════════════════════════════════
// ★Писатель — ОДИН поток с очередью, которым владеет адаптер. Поток на
// каждый SAVE с FreeOnTerminate не держал никто: штатный выход из программы
// обрывал запись на полуслове (из 100000044 байт на диске оставалось
// 40960), а медленный каталог плодил сотни потоков мимо бюджета.
Path := GetTempDir + 'tcitest_rec.wav';
Path2 := GetTempDir + 'tcitest_rec2.wav';
DeleteFile(Path);
DeleteFile(Path2);
SetLength(Data, 2000);
for i := 0 to 1999 do Data[i] := i * 8;
Tk.Chunks := nil;
SetLength(Tk.Chunks, 1);
Tk.Chunks[0] := Data;
Tk.Chunk := Length(Data) div 2;
Tk.Count := Tk.Chunk;
Tk.Reserved := 0;
W := TTCIWavWriter.Create(Path, Tk, 48000);
Waited := 0;
while (not FileExists(Path)) and (Waited < 2000) do
begin
Sleep(10);
Inc(Waited, 10);
end;
Sleep(50);
W := TTCIWavWriter.Create;
Check('WAV: задание принято', W.Enqueue(Path, MakeTake(Data, 0), 48000));
Check('WAV: очередь дописана', Drained(W, 5000));
if not FileExists(Path) then
Check('WAV: файл создан', False)
else
@@ -794,50 +831,148 @@ begin
finally
FS.Free;
end;
// ★Данные пишутся во временный файл и переименовываются поверх занятого
// имени: по имени файла клиент считает запись готовой, и незаконченного
// содержимого он там видеть не должен. После удачи «.part» не остаётся.
Check('WAV: временный файл убран', PartFiles(Path) = 0,
IntToStr(PartFiles(Path)));
// ★Писатель отпускает резерв, когда данные ему больше не нужны — иначе
// потолок памяти держал бы только сами записи, а очередь сохранений на
// медленном диске росла бы мимо него.
Was := TCIRecBudgetUsed;
Check('WAV: резерв под писателя взят', TCIRecBudgetTake(4096));
DeleteFile(Path);
Tk.Chunks := nil;
SetLength(Tk.Chunks, 1);
Tk.Chunks[0] := Data;
Tk.Chunk := Length(Data) div 2;
Tk.Count := Tk.Chunk;
Tk.Reserved := 4096;
TTCIWavWriter.Create(Path, Tk, 48000);
Waited := 0;
while (TCIRecBudgetUsed <> Was) and (Waited < 2000) do
begin
Sleep(10);
Inc(Waited, 10);
end;
W.Enqueue(Path, MakeTake(Data, 4096), 48000);
Drained(W, 5000);
Check('WAV: писатель вернул резерв по окончании',
TCIRecBudgetUsed = Was, IntToStr(TCIRecBudgetUsed - Was));
// ★Существующий файл не трогаем: имя приходит из сети, и fmCreate затирал
// бы любой доступный процессу файл. Пишем поверх заведомо другой длиной —
// файл обязан остаться прежним.
SetLength(Data, 10);
for i := 0 to 9 do Data[i] := 1;
Tk.Chunks := nil;
SetLength(Tk.Chunks, 1);
Tk.Chunks[0] := Data;
Tk.Chunk := 5;
Tk.Count := 5;
Tk.Reserved := 0;
TTCIWavWriter.Create(Path, Tk, 48000);
Sleep(200);
Tk := MakeTake(Copy(Data, 0, 10), 0);
W.Enqueue(Path, Tk, 48000);
Drained(W, 5000);
FS := TFileStream.Create(Path, fmOpenRead);
try
Check('WAV: существующий файл не перезаписан',
// Публикация идёт link(2)/MoveFileW без замены: занятое имя = отказ.
Check('WAV: существующий файл не перезаписан',
FS.Size = 44 + 2000 * 2, IntToStr(FS.Size));
finally
FS.Free;
end;
Check('WAV: отказ не оставил временного файла', PartFiles(Path) = 0);
DeleteFile(Path);
end;
// ★Запись не удалась на полпути — по имени не остаётся НИЧЕГО. Прежний код
// не смотрел на результат записи вовсе (FileWrite и THandleStream.Write при
// ошибке возвращают 0 и не поднимают исключения), и на полном диске
// оставался огрызок с заголовком на полную длину. Здесь тот же путь:
// счётчик обещает больше, чем есть в кусках.
Tk := MakeTake(Data, 0);
Tk.Count := Tk.Count * 3; // кусков под это нет
W.Enqueue(Path, Tk, 48000);
Drained(W, 5000);
Check('WAV: неудачная запись не оставила файла', not FileExists(Path));
Check('WAV: неудачная запись не оставила «.part»', PartFiles(Path) = 0);
// ★Целевого имени не существует, ПОКА запись не готова. Раньше по нему
// сразу появлялась пустышка на 0 байт (имя занималось эксклюзивно, а данные
// шли во временный файл), и на медленном диске клиент видел её всю запись —
// а по имени файла он вправе считать запись готовой. Пишем 32 МБ и всё это
// время следим за именем: увидели его непустым, но не полным, или пустым —
// проверка красная.
SetLength(Big, 16 * 1024 * 1024); // 32 МБ: заведомо дольше, чем цикл ниже
FillChar(Big[0], Length(Big) * SizeOf(SmallInt), 0);
DeleteFile(Path2);
W.Enqueue(Path2, MakeTake(Big, 0), 48000);
Bad := 0;
while W.Pending > 0 do
if FileExists(Path2) then
begin
FS := TFileStream.Create(Path2, fmOpenRead or fmShareDenyNone);
try
if FS.Size <> 44 + Int64(Length(Big)) * SizeOf(SmallInt) then Inc(Bad);
finally
FS.Free;
end;
end;
Check('WAV: незаконченной записи под целевым именем не видно', Bad = 0,
IntToStr(Bad));
Check('WAV: 32 МБ дописаны', Drained(W, 20000));
DeleteFile(Path2);
// ★Очередь ограничена. Раньше «сохранить» было равно «создать поток», и
// зависший сетевой каталог давал их сотни — память стеков в бюджет не
// входит. Занимаем писателя большой записью и стучимся сверх потолка.
W.Enqueue(Path2, MakeTake(Big, 0), 48000);
Refused := 0;
for k := 0 to TCI_RECORD_MAX_JOBS + 3 do
if not W.Enqueue(GetTempDir + Format('tcitest_q%d.wav', [k]),
MakeTake(Data, 0), 48000) then
Inc(Refused);
Check('очередь: сверх потолка заданий отказ', Refused > 0,
IntToStr(Refused));
Check('очередь: дописалась', Drained(W, 20000));
for k := 0 to TCI_RECORD_MAX_JOBS + 3 do
DeleteFile(GetTempDir + Format('tcitest_q%d.wav', [k]));
// Гасят — новых заданий не принимаем: место в бюджете остаётся на
// вызывающем, и он обязан его вернуть сам (так и делает CmdRecorder).
W.Close;
Check('очередь: после Close заданий не берём',
not W.Enqueue(Path, MakeTake(Data, 0), 48000));
TCIStopWriter(W);
Check('очередь: TCIStopWriter обнуляет ссылку', W = nil);
// ★★Главная проверка P1: закрытие программы ДОЖИДАЕТСЯ записи. Раньше
// FreeOnTerminate-поток никто не ждал, и файл обрывался там, где его застал
// выход. Здесь сразу после остановки писателя файл обязан быть целым.
// ★И не только первый: за хвостом очереди клиенту тоже сказано «сохранено»,
// поэтому ждём ВСЮ очередь (срок остановки считается от последнего
// продвижения, а не от её начала).
DeleteFile(Path2);
for k := 0 to 1 do DeleteFile(GetTempDir + Format('tcitest_tail%d.wav', [k]));
W := TTCIWavWriter.Create;
Check('выход: задание принято', W.Enqueue(Path2, MakeTake(Big, 0), 48000));
for k := 0 to 1 do
W.Enqueue(GetTempDir + Format('tcitest_tail%d.wav', [k]),
MakeTake(Data, 0), 48000);
TCIStopWriter(W);
Bad := 0;
for k := 0 to 1 do
begin
Path := GetTempDir + Format('tcitest_tail%d.wav', [k]);
if not FileExists(Path) then Inc(Bad)
else
begin
FS := TFileStream.Create(Path, fmOpenRead);
try
if FS.Size <> 44 + 2000 * 2 then Inc(Bad);
finally
FS.Free;
end;
DeleteFile(Path);
end;
end;
Check('выход: хвост очереди тоже дописан', Bad = 0, IntToStr(Bad));
if not FileExists(Path2) then
Check('выход: файл дописан до конца', False)
else
begin
FS := TFileStream.Create(Path2, fmOpenRead);
try
Check('выход: файл дописан до конца',
FS.Size = 44 + Int64(Length(Big)) * SizeOf(SmallInt),
IntToStr(FS.Size));
finally
FS.Free;
end;
DeleteFile(Path2);
end;
Big := nil;
end;
{ ═══════════════════════════════════════════════════════════════════════════